From b9b235cff96fb295d041276202b5dae09f553154 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Przemys=C5=82aw=20Czerpak?= Date: Wed, 3 Dec 2014 00:41:38 +0100 Subject: [PATCH] 2014-12-03 00:41 UTC+0100 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) * include/hbsocket.ch + added HB_SOCKET_ERR_NONE MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/rtl/hbsocket.c * clear socket error when hb_socketRecv*() or hb_socketSend*() returns value greater then 0 % removed unnecessary error code setting in MS-Windows builds of hb_socketGetIFaces() * src/rtl/filesys.c ! allocate dynamically buffer for current directory name if default one is too small when current disk is checked * src/rtl/hbzlib.c * use hb_xalloc()/hb_xfree() to allocate/free memory during ZLIB compression and decompression instead of ZLIB default ones (finished code started in Viktor's branch) * src/rtl/tlabel.prg * src/rtl/treport.prg % use hb_ATokens() instead of local functions ListAsArray() * simplified reading labels and reports from files * src/rtl/teditor.prg * src/rtl/tget.prg * src/rtl/tlabel.prg * src/rtl/treport.prg * synced with Viktor's branch: removed explicit NIL from parameters, formatting, updated comments and variable names, use FOR EACH and SWITCH statements, use hb_defaultValue(), use hb_StrShrink(), formatting, few fixes * src/rtl/langcomp.prg * synced with Viktor's branch * src/rtl/memoedit.prg * synced with Viktor's branch, optimizations, formatting and fixes: ; 2014-03-28 13:09 UTC+0100 Viktor Szakats + MemoEdit(): allow BLOCK and SYMBOL types for user callbacks (only in the default, non-strict mode) ! MemoEdit(): fixed to only handle certain types of events in ME_INIT stage in harmony with Cl*pper documentation ! MemoEdit(): fixed to not get into an infinite loop on initialization when user callback is returning unhandled value https://github.com/harbour/core/issues/21 ! MemoEdit()/HBMemoEditor():KeyboardHook(): fixed to fall back to default handling of K_ESC if getting called recursively https://github.com/harbour/core/issues/21 + HBMemoEditor():HandleUserKey(): now returns whether the event was handled (as logical value) (previously: Self) [INCOMPATIBLE] * fixed some misleading variable names ; 2014-01-28 03:11 UTC+0100 Viktor Szakáts ! MemoEdit() fixed to pass-through without interactivity when the user function is a boolean .F. ; 2014-01-27 15:15 UTC+0100 Viktor Szakáts % abort key checking optimized and made unicode compatible * src/rtl/listbox.prg * synced with Viktor's branch, optimizations, formatting and fixes: ; 2014-07-21 08:56 UTC+0200 Viktor Szakats ! ListBox():findData(): fixed to be able to search for non-string data, to the same extent Cl*ipper is able to. ! ListBox():findData(): fixed exact/case-insensitive regression from 6f8508ff54a3955822b36bf4a65a2775a11bab23 ; 2014-07-21 03:26 UTC+0200 Viktor Szakats + LISTBOX object instance area made compatible with Cl*pper (relevant when object is accessed as array) ; 2014-07-21 01:20 UTC+0200 Viktor Szakats * renamed variable and macro to reflect their type + ListBox():findData(): documented potential RTE ; 2014-07-21 01:04 UTC+0200 Viktor Szakats % ListBox():findText(), ListBox():findData(): use hb_LeftEq[I]() ! ListBox():findText(), ListBox():findData(): fixed to not RTrim() while searching in EXACT mode. Regression from f61409bf19731c8485aa29bae273cae090c77502 + ListBox():findText(), ListBox():findData(): allow to search for any type of data in HB_CLP_STRICT mode to mimic Cl*pper behavior ! ListBox():findText(): fixed to allow zero length search text, like Cl*pper. Regression from 93d3a46d843daaf6d08149d83fa5203ff910c484 ! ListBox():addItem( cText, cData ): fixed to allow any type for cData, not just NIL and string, like Cl*pper + ListBox():setData(): documented a Cl*pper bug ; 2014-03-09 18:19 UTC+0100 Viktor Szakáts ! ListBox():scroll() fixed to ignore non-numeric parameter (like Cl*pper) instead of an RTE --- ChangeLog.txt | 86 ++++++ include/hbsocket.ch | 1 + src/rtl/filesys.c | 13 +- src/rtl/hbsocket.c | 10 +- src/rtl/hbzlib.c | 222 ++++++++------- src/rtl/langcomp.prg | 60 +++- src/rtl/listbox.prg | 339 +++++++++++------------ src/rtl/memoedit.prg | 220 ++++++++------- src/rtl/teditor.prg | 157 +++++------ src/rtl/tget.prg | 28 +- src/rtl/tlabel.prg | 189 ++++--------- src/rtl/treport.prg | 640 ++++++++++++++++--------------------------- 12 files changed, 925 insertions(+), 1040 deletions(-) diff --git a/ChangeLog.txt b/ChangeLog.txt index d5ff0962d1..db0f547718 100644 --- a/ChangeLog.txt +++ b/ChangeLog.txt @@ -10,6 +10,92 @@ * Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment */ +2014-12-03 00:41 UTC+0100 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) + * include/hbsocket.ch + + added HB_SOCKET_ERR_NONE + + * src/rtl/hbsocket.c + * clear socket error when hb_socketRecv*() or hb_socketSend*() returns + value greater then 0 + % removed unnecessary error code setting in MS-Windows builds + of hb_socketGetIFaces() + + * src/rtl/filesys.c + ! allocate dynamically buffer for current directory name if default + one is too small when current disk is checked + + * src/rtl/hbzlib.c + * use hb_xalloc()/hb_xfree() to allocate/free memory during + ZLIB compression and decompression instead of ZLIB default + ones (finished code started in Viktor's branch) + + * src/rtl/tlabel.prg + * src/rtl/treport.prg + % use hb_ATokens() instead of local functions ListAsArray() + * simplified reading labels and reports from files + + * src/rtl/teditor.prg + * src/rtl/tget.prg + * src/rtl/tlabel.prg + * src/rtl/treport.prg + * synced with Viktor's branch: + removed explicit NIL from parameters, formatting, updated comments + and variable names, use FOR EACH and SWITCH statements, + use hb_defaultValue(), use hb_StrShrink(), formatting, few fixes + + * src/rtl/langcomp.prg + * synced with Viktor's branch + + * src/rtl/memoedit.prg + * synced with Viktor's branch, optimizations, formatting and fixes: + ; 2014-03-28 13:09 UTC+0100 Viktor Szakats + + MemoEdit(): allow BLOCK and SYMBOL types for user callbacks + (only in the default, non-strict mode) + ! MemoEdit(): fixed to only handle certain types of events in ME_INIT + stage in harmony with Cl*pper documentation + ! MemoEdit(): fixed to not get into an infinite loop on initialization + when user callback is returning unhandled value + https://github.com/harbour/core/issues/21 + ! MemoEdit()/HBMemoEditor():KeyboardHook(): fixed to fall back to + default handling of K_ESC if getting called recursively + https://github.com/harbour/core/issues/21 + + HBMemoEditor():HandleUserKey(): now returns whether the event was + handled (as logical value) (previously: Self) [INCOMPATIBLE] + * fixed some misleading variable names + ; 2014-01-28 03:11 UTC+0100 Viktor Szakáts + ! MemoEdit() fixed to pass-through without interactivity + when the user function is a boolean .F. + ; 2014-01-27 15:15 UTC+0100 Viktor Szakáts + % abort key checking optimized and made unicode compatible + + * src/rtl/listbox.prg + * synced with Viktor's branch, optimizations, formatting and fixes: + ; 2014-07-21 08:56 UTC+0200 Viktor Szakats + ! ListBox():findData(): fixed to be able to search for non-string + data, to the same extent Cl*ipper is able to. + ! ListBox():findData(): fixed exact/case-insensitive regression + from 6f8508ff54a3955822b36bf4a65a2775a11bab23 + ; 2014-07-21 03:26 UTC+0200 Viktor Szakats + + LISTBOX object instance area made compatible with Cl*pper + (relevant when object is accessed as array) + ; 2014-07-21 01:20 UTC+0200 Viktor Szakats + * renamed variable and macro to reflect their type + + ListBox():findData(): documented potential RTE + ; 2014-07-21 01:04 UTC+0200 Viktor Szakats + % ListBox():findText(), ListBox():findData(): use hb_LeftEq[I]() + ! ListBox():findText(), ListBox():findData(): fixed to not RTrim() + while searching in EXACT mode. Regression from f61409bf19731c8485aa29bae273cae090c77502 + + ListBox():findText(), ListBox():findData(): allow to search + for any type of data in HB_CLP_STRICT mode to mimic Cl*pper behavior + ! ListBox():findText(): fixed to allow zero length search text, + like Cl*pper. Regression from 93d3a46d843daaf6d08149d83fa5203ff910c484 + ! ListBox():addItem( cText, cData ): fixed to allow any type for cData, + not just NIL and string, like Cl*pper + + ListBox():setData(): documented a Cl*pper bug + ; 2014-03-09 18:19 UTC+0100 Viktor Szakáts + ! ListBox():scroll() fixed to ignore non-numeric parameter + (like Cl*pper) instead of an RTE + 2014-11-29 06:03 UTC+0100 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) * include/hbapifs.h * src/common/hbffind.c diff --git a/include/hbsocket.ch b/include/hbsocket.ch index 819326f863..284f1e05b5 100644 --- a/include/hbsocket.ch +++ b/include/hbsocket.ch @@ -52,6 +52,7 @@ #define HB_SOCKET_CH_ /* Harbour socket error codes */ +#define HB_SOCKET_ERR_NONE 0 #define HB_SOCKET_ERR_PIPE 1 #define HB_SOCKET_ERR_TIMEOUT 2 #define HB_SOCKET_ERR_WRONGADDR 3 diff --git a/src/rtl/filesys.c b/src/rtl/filesys.c index 45cb649b7e..0fc45b1e9c 100644 --- a/src/rtl/filesys.c +++ b/src/rtl/filesys.c @@ -350,12 +350,17 @@ static HB_BOOL s_fUseWaitLocks = HB_TRUE; static int fs_win_get_drive( void ) { - TCHAR lpBuffer[ HB_PATH_MAX ]; + TCHAR pBuffer[ HB_PATH_MAX ]; + LPTSTR lpBuffer = pBuffer; DWORD dwResult; int iDrive = 0; - lpBuffer[ 0 ] = TEXT( '\0' ); - dwResult = GetCurrentDirectory( HB_SIZEOFARRAY( lpBuffer ), lpBuffer ); + dwResult = GetCurrentDirectory( HB_SIZEOFARRAY( pBuffer ), lpBuffer ); + if( dwResult > HB_SIZEOFARRAY( lpBuffer ) ) + { + lpBuffer = ( TCHAR * ) hb_xgrab( dwResult * sizeof( TCHAR ) ); + dwResult = GetCurrentDirectory( dwResult, lpBuffer ); + } hb_fsSetIOError( dwResult != 0, 0 ); if( dwResult >= 2 && lpBuffer[ 1 ] == HB_OS_DRIVE_DELIM_CHR ) { @@ -365,6 +370,8 @@ static int fs_win_get_drive( void ) else iDrive = 0; } + if( lpBuffer != pBuffer ) + hb_xfree( lpBuffer ); return iDrive; } diff --git a/src/rtl/hbsocket.c b/src/rtl/hbsocket.c index 8b59cf99a3..4b99dfbb84 100644 --- a/src/rtl/hbsocket.c +++ b/src/rtl/hbsocket.c @@ -2341,7 +2341,7 @@ long hb_socketSend( HB_SOCKET sd, const void * data, long len, int flags, HB_MAX do { lSent = send( sd, ( const char * ) data, len, flags ); - iError = HB_SOCK_GETERROR(); + iError = lSent > 0 ? 0 : HB_SOCK_GETERROR(); hb_socketSetOsError( iError ); } while( lSent == -1 && HB_SOCK_IS_EINTR( iError ) && @@ -2380,7 +2380,7 @@ long hb_socketSendTo( HB_SOCKET sd, const void * data, long len, int flags, { lSent = sendto( sd, ( const char * ) data, len, flags, ( const struct sockaddr * ) pSockAddr, ( socklen_t ) uiSockLen ); - iError = HB_SOCK_GETERROR(); + iError = lSent > 0 ? 0 : HB_SOCK_GETERROR(); hb_socketSetOsError( iError ); } while( lSent == -1 && HB_SOCK_IS_EINTR( iError ) && @@ -2413,7 +2413,7 @@ long hb_socketRecv( HB_SOCKET sd, void * data, long len, int flags, HB_MAXINT ti do { lReceived = recv( sd, ( char * ) data, len, flags ); - iError = HB_SOCK_GETERROR(); + iError = lReceived > 0 ? 0 : HB_SOCK_GETERROR(); hb_socketSetOsError( iError ); } while( lReceived == -1 && HB_SOCK_IS_EINTR( iError ) && @@ -2454,7 +2454,7 @@ long hb_socketRecvFrom( HB_SOCKET sd, void * data, long len, int flags, void ** do { lReceived = recvfrom( sd, ( char * ) data, len, flags, &st.sa, &salen ); - iError = HB_SOCK_GETERROR(); + iError = lReceived > 0 ? 0 : HB_SOCK_GETERROR(); hb_socketSetOsError( iError ); } while( lReceived == -1 && HB_SOCK_IS_EINTR( iError ) && @@ -3604,8 +3604,6 @@ PHB_ITEM hb_socketGetIFaces( int af, HB_BOOL fNoAliases ) hb_xfree( pBuffer ); hb_socketClose( sd ); } - else - iError = HB_SOCK_GETERROR(); #else int iTODO; HB_SYMBOL_UNUSED( af ); diff --git a/src/rtl/hbzlib.c b/src/rtl/hbzlib.c index ae601f24f4..21f1a56fe8 100644 --- a/src/rtl/hbzlib.c +++ b/src/rtl/hbzlib.c @@ -61,13 +61,13 @@ we have to miss compressBound() when using zlib 1.2.0. [vszakats] */ /* ZLIB_VERNUM were added in version 1.2.0.2 so it cannot be used for older zlib libraries */ -#if defined( Z_RLE ) - #define _HB_Z_COMPRESSBOUND +#if defined( Z_RLE ) && ! defined( Z_SOLO ) +#define _HB_Z_COMPRESSBOUND #endif #if ! defined( _HB_Z_COMPRESSBOUND ) /* additional 12 bytes is for GZIP compression which uses bigger header */ -#define deflateBound( s, n ) ( hb_zlibCompressBound( n ) + 12 ) +#define deflateBound( s, n ) ( hb_zlibCompressBound( n ) + ( fGZip ? 12 : 0 ) ) #endif static HB_SIZE s_zlibCompressBound( HB_SIZE nLen ) @@ -79,101 +79,36 @@ static HB_SIZE s_zlibCompressBound( HB_SIZE nLen ) #endif } -static HB_SIZE s_zlibUncompressedSize( const char * szSrc, HB_SIZE nLen, - int * piResult ) +static void * s_zlib_alloc( void * cargo, uInt items, uInt size ) +{ + HB_SYMBOL_UNUSED( cargo ); + + return ( items > 0 && size > 0 ) ? hb_xalloc( ( HB_SIZE ) items * size ) : NULL; +} + +static void s_zlib_free( void * cargo, void * address ) +{ + HB_SYMBOL_UNUSED( cargo ); + + if( address ) + hb_xfree( address ); +} + +static int s_zlibCompress2( char ** pDstPtr, HB_SIZE * pnDst, + const char * pSrc, HB_SIZE nSrc, + HB_BOOL fGZip, int level ) { - Byte buffer[ 1024 ]; z_stream stream; - HB_SIZE nDest = 0; + int iResult; memset( &stream, 0, sizeof( z_stream ) ); - - stream.next_in = ( Bytef * ) szSrc; - stream.avail_in = ( uInt ) nLen; -/* - stream.zalloc = Z_NULL; - stream.zfree = Z_NULL; + stream.zalloc = s_zlib_alloc; + stream.zfree = s_zlib_free; stream.opaque = NULL; - */ - - *piResult = inflateInit2( &stream, 15 + 32 ); - if( *piResult == Z_OK ) - { - do - { - stream.next_out = buffer; - stream.avail_out = sizeof( buffer ); - *piResult = inflate( &stream, Z_NO_FLUSH ); - } - while( *piResult == Z_OK ); - - if( *piResult == Z_STREAM_END ) - { - nDest = stream.total_out; - *piResult = Z_OK; - } - inflateEnd( &stream ); - } - - return nDest; -} - -static int s_zlibUncompress( char * pDst, HB_SIZE * pnDst, - const char * pSrc, HB_SIZE nSrc ) -{ - z_stream stream; - int iResult; - - memset( &stream, 0, sizeof( z_stream ) ); stream.next_in = ( Bytef* ) pSrc; stream.avail_in = ( uInt ) nSrc; - iResult = inflateInit2( &stream, 15 + 32 ); - - if( iResult == Z_OK ) - { - stream.next_out = ( Bytef* ) pDst; - stream.avail_out = ( uInt ) *pnDst; - - do - { - iResult = inflate( &stream, Z_FINISH ); - } - while( iResult == Z_OK ); - - if( iResult == Z_STREAM_END ) - { - *pnDst = stream.total_out; - iResult = Z_OK; - } - inflateEnd( &stream ); - } - - return iResult; -} - -static int s_zlibCompress( char * pDst, HB_SIZE * pnDst, - const char * pSrc, HB_SIZE nSrc, int level ) -{ - uLong ulDst = ( uLong ) *pnDst; - int iResult; - - iResult = compress2( ( Bytef * ) pDst, &ulDst, - ( Bytef * ) pSrc, ( uLong ) nSrc, level ); - *pnDst = ulDst; - - return iResult; -} - -static int hb_gz_compress( char ** pDstPtr, HB_SIZE * pnDst, - const char * pSrc, HB_SIZE nSrc, int level ) -{ - z_stream stream; - int iResult; - - memset( &stream, 0, sizeof( z_stream ) ); - stream.next_in = ( Bytef* ) pSrc; - stream.avail_in = ( uInt ) nSrc; - iResult = deflateInit2( &stream, level, Z_DEFLATED, 15 + 16, 8, + iResult = deflateInit2( &stream, level, Z_DEFLATED, + 15 + ( fGZip ? 16 : 0 ), 8, Z_DEFAULT_STRATEGY ); if( iResult == Z_OK ) { @@ -209,6 +144,84 @@ static int hb_gz_compress( char ** pDstPtr, HB_SIZE * pnDst, return iResult; } +static int s_zlibCompress( char * pDst, HB_SIZE * pnDst, + const char * pSrc, HB_SIZE nSrc, int level ) +{ + return s_zlibCompress2( &pDst, pnDst, pSrc, nSrc, HB_FALSE, level ); +} + +static HB_SIZE s_zlibUncompressedSize( const char * szSrc, HB_SIZE nLen, + int * piResult ) +{ + Byte buffer[ 1024 ]; + z_stream stream; + HB_SIZE nDest = 0; + + memset( &stream, 0, sizeof( z_stream ) ); + stream.zalloc = s_zlib_alloc; + stream.zfree = s_zlib_free; + stream.opaque = NULL; + stream.next_in = ( Bytef * ) szSrc; + stream.avail_in = ( uInt ) nLen; + + *piResult = inflateInit2( &stream, 15 + 32 ); + if( *piResult == Z_OK ) + { + do + { + stream.next_out = buffer; + stream.avail_out = sizeof( buffer ); + *piResult = inflate( &stream, Z_NO_FLUSH ); + } + while( *piResult == Z_OK ); + + if( *piResult == Z_STREAM_END ) + { + nDest = stream.total_out; + *piResult = Z_OK; + } + inflateEnd( &stream ); + } + + return nDest; +} + +static int s_zlibUncompress( char * pDst, HB_SIZE * pnDst, + const char * pSrc, HB_SIZE nSrc ) +{ + z_stream stream; + int iResult; + + memset( &stream, 0, sizeof( z_stream ) ); + stream.zalloc = s_zlib_alloc; + stream.zfree = s_zlib_free; + stream.opaque = NULL; + stream.next_in = ( Bytef* ) pSrc; + stream.avail_in = ( uInt ) nSrc; + iResult = inflateInit2( &stream, 15 + 32 ); + + if( iResult == Z_OK ) + { + stream.next_out = ( Bytef* ) pDst; + stream.avail_out = ( uInt ) *pnDst; + + do + { + iResult = inflate( &stream, Z_FINISH ); + } + while( iResult == Z_OK ); + + if( iResult == Z_STREAM_END ) + { + *pnDst = stream.total_out; + iResult = Z_OK; + } + inflateEnd( &stream ); + } + + return iResult; +} + /* * hb_ZLibVersion( [] ) -> */ @@ -280,6 +293,7 @@ HB_FUNC( HB_ZCOMPRESS ) if( nLen ) { PHB_ITEM pBuffer = HB_ISBYREF( 2 ) ? hb_param( 2, HB_IT_STRING ) : NULL; + HB_BOOL fAlloc = HB_FALSE; HB_SIZE nDstLen; char * pDest; int iResult; @@ -291,20 +305,28 @@ HB_FUNC( HB_ZCOMPRESS ) } else { - nDstLen = HB_ISNUM( 2 ) ? ( HB_SIZE ) hb_parns( 2 ) : - s_zlibCompressBound( nLen ); - pDest = ( char * ) hb_xalloc( nDstLen + 1 ); + if( HB_ISNUM( 2 ) ) + { + nDstLen = hb_parns( 2 ); + pDest = ( char * ) hb_xalloc( nDstLen + 1 ); + } + else + { + pDest = NULL; + nDstLen = 0; + fAlloc = HB_TRUE; + } } - if( pDest ) + if( pDest || fAlloc ) { - iResult = s_zlibCompress( pDest, &nDstLen, szData, nLen, - hb_parnidef( 4, Z_DEFAULT_COMPRESSION ) ); + iResult = s_zlibCompress2( &pDest, &nDstLen, szData, nLen, HB_FALSE, + hb_parnidef( 4, Z_DEFAULT_COMPRESSION ) ); if( ! pBuffer ) { if( iResult == Z_OK ) hb_retclen_buffer( pDest, nDstLen ); - else + else if( pDest ) hb_xfree( pDest ); } else if( iResult == Z_OK ) @@ -445,8 +467,8 @@ HB_FUNC( HB_GZCOMPRESS ) if( pDest || fAlloc ) { - iResult = hb_gz_compress( &pDest, &nDstLen, szData, nLen, - hb_parnidef( 4, Z_DEFAULT_COMPRESSION ) ); + iResult = s_zlibCompress2( &pDest, &nDstLen, szData, nLen, HB_TRUE, + hb_parnidef( 4, Z_DEFAULT_COMPRESSION ) ); if( ! pBuffer ) { if( iResult == Z_OK ) diff --git a/src/rtl/langcomp.prg b/src/rtl/langcomp.prg index 485b0e0077..b29138da20 100644 --- a/src/rtl/langcomp.prg +++ b/src/rtl/langcomp.prg @@ -46,13 +46,11 @@ * */ -REQUEST HB_CODEPAGE_UTF8 - #ifdef HB_LEGACY_LEVEL4 - /* Required for legacy language modules with a two character ID. - These cannot have a compatibility puller symbol in langlgcy.prg, - which in turn pulls all CP modules, so we're pulling them from - here. */ +/* Required for legacy language modules with a two character ID. + These cannot have a compatibility puller symbol in langlgcy.prg, + which in turn pulls all CP modules, so we're pulling them from + here. */ REQUEST HB_CODEPAGE_CS852 REQUEST HB_CODEPAGE_DE850 REQUEST HB_CODEPAGE_EL737 @@ -154,19 +152,19 @@ FUNCTION hb_langSelect( cLangID, cCP ) ENDIF #ifdef HB_LEGACY_LEVEL4 - IF ! Empty( cLangIDBase ) - /* Legacy emulation */ - cLangID := cLangIDBase - ELSE + IF Empty( cLangIDBase ) #endif /* Support standard ISO language IDs */ - IF ! Empty( tmp := __LangStdToLangHb( cLangID ) ) - cLangID := cLangIDBase := tmp - ELSE + IF Empty( tmp := __LangStdToLangHb( cLangID ) ) /* Normal case */ cLangIDBase := cLangID + ELSE + cLangID := cLangIDBase := tmp ENDIF #ifdef HB_LEGACY_LEVEL4 + ELSE + /* Legacy emulation */ + cLangID := cLangIDBase ENDIF #endif @@ -184,6 +182,7 @@ STATIC FUNCTION __LangStdToLangHb( cLangStd ) IF HB_ISSTRING( cLangStd ) SWITCH Lower( StrTran( cLangStd, "_", "-" ) ) +#if 0 CASE "af-za" ; EXIT CASE "af" ; EXIT CASE "ar-ae" ; EXIT @@ -207,24 +206,31 @@ STATIC FUNCTION __LangStdToLangHb( cLangStd ) CASE "az-az-latn" ; EXIT CASE "az" ; EXIT CASE "be-by" ; EXIT +#endif CASE "be" ; cLangHb := "be" ; EXIT CASE "bg-bg" CASE "bg" ; cLangHb := "bg" ; EXIT CASE "ca-es" CASE "ca" ; cLangHb := "ca" ; EXIT +#if 0 CASE "cy-gb" ; EXIT +#endif CASE "cs-cz" CASE "cs" ; cLangHb := "cs" ; EXIT +#if 0 CASE "da-dk" ; EXIT CASE "da" ; EXIT +#endif CASE "de-at" CASE "de-ch" CASE "de-de" CASE "de-li" CASE "de-lu" CASE "de" ; cLangHb := "de" ; EXIT +#if 0 CASE "div-mv" ; EXIT CASE "div" ; EXIT +#endif CASE "el-gr" CASE "el" ; cLangHb := "el" ; EXIT CASE "en-au" @@ -263,16 +269,20 @@ STATIC FUNCTION __LangStdToLangHb( cLangStd ) CASE "es-uy" CASE "es-ve" CASE "es" ; cLangHb := "es" ; EXIT +#if 0 CASE "et-ee" ; EXIT CASE "et" ; EXIT +#endif CASE "eu-es" CASE "eu" ; cLangHb := "eu" ; EXIT +#if 0 CASE "fa-ir" ; EXIT CASE "fa" ; EXIT CASE "fi-fi" ; EXIT CASE "fi" ; EXIT CASE "fo-fo" ; EXIT CASE "fo" ; EXIT +#endif CASE "fr-be" CASE "fr-ca" CASE "fr-ch" @@ -282,18 +292,24 @@ STATIC FUNCTION __LangStdToLangHb( cLangStd ) CASE "fr" ; cLangHb := "fr" ; EXIT CASE "gl-es" CASE "gl" ; cLangHb := "gl" ; EXIT +#if 0 CASE "gu-in" ; EXIT CASE "gu" ; EXIT +#endif CASE "he-il" CASE "he" ; cLangHb := "he" ; EXIT +#if 0 CASE "hi-in" ; EXIT CASE "hi" ; EXIT +#endif CASE "hr-hr" CASE "hr" ; cLangHb := "hr" ; EXIT CASE "hu-hu" CASE "hu" ; cLangHb := "hu" ; EXIT +#if 0 CASE "hy-am" ; EXIT CASE "hy" ; EXIT +#endif CASE "id-id" CASE "id" ; cLangHb := "id" ; EXIT CASE "is-is" @@ -301,6 +317,7 @@ STATIC FUNCTION __LangStdToLangHb( cLangStd ) CASE "it-ch" CASE "it-it" CASE "it" ; cLangHb := "it" ; EXIT +#if 0 CASE "ja-jp" ; EXIT CASE "ja" ; EXIT CASE "ka-ge" ; EXIT @@ -309,14 +326,18 @@ STATIC FUNCTION __LangStdToLangHb( cLangStd ) CASE "kk" ; EXIT CASE "kn-in" ; EXIT CASE "kn" ; EXIT +#endif CASE "ko-kr" CASE "ko" ; cLangHb := "ko" ; EXIT +#if 0 CASE "kok-in" ; EXIT CASE "kok" ; EXIT CASE "ky-kz" ; EXIT CASE "ky" ; EXIT +#endif CASE "lt-lt" CASE "lt" ; cLangHb := "lt" ; EXIT +#if 0 CASE "lv-lv" ; EXIT CASE "lv" ; EXIT CASE "mk-mk" ; EXIT @@ -329,13 +350,16 @@ STATIC FUNCTION __LangStdToLangHb( cLangStd ) CASE "ms-my" ; EXIT CASE "ms" ; EXIT CASE "nb-no" ; EXIT +#endif CASE "nl-be" CASE "nl-nl" CASE "nl" ; cLangHb := "nl" ; EXIT +#if 0 CASE "nn-no" ; EXIT CASE "no" ; EXIT CASE "pa-in" ; EXIT CASE "pa" ; EXIT +#endif CASE "pl-pl" CASE "pl" ; cLangHb := "pl" ; EXIT CASE "pt-br" ; cLangHb := "pt_br" ; EXIT @@ -345,19 +369,24 @@ STATIC FUNCTION __LangStdToLangHb( cLangStd ) CASE "ro" ; cLangHb := "ro" ; EXIT CASE "ru-ru" CASE "ru" ; cLangHb := "ru" ; EXIT +#if 0 CASE "sa-in" ; EXIT CASE "sa" ; EXIT +#endif CASE "sk-sk" CASE "sk" ; cLangHb := "sk" ; EXIT CASE "sl-si" CASE "sl" ; cLangHb := "sl" ; EXIT +#if 0 CASE "sq-al" ; EXIT CASE "sq" ; EXIT +#endif CASE "sr-sp-cyrl" ; cLangHb := "sr_cyr" ; EXIT CASE "sr-sp-latn" ; cLangHb := "sr_lat" ; EXIT CASE "sv-fi" CASE "sv-se" CASE "sv" ; cLangHb := "sv" ; EXIT +#if 0 CASE "sw-ke" ; EXIT CASE "sw" ; EXIT CASE "syr-sy" ; EXIT @@ -368,12 +397,16 @@ STATIC FUNCTION __LangStdToLangHb( cLangStd ) CASE "te" ; EXIT CASE "th-th" ; EXIT CASE "th" ; EXIT +#endif CASE "tr-tr" CASE "tr" ; cLangHb := "tr" ; EXIT +#if 0 CASE "tt-ru" ; EXIT CASE "tt" ; EXIT +#endif CASE "uk-ua" CASE "uk" ; cLangHb := "uk" ; EXIT +#if 0 CASE "ur-pk" ; EXIT CASE "ur" ; EXIT CASE "uz-uz-cyrl" ; EXIT @@ -381,6 +414,7 @@ STATIC FUNCTION __LangStdToLangHb( cLangStd ) CASE "uz" ; EXIT CASE "vi-vn" ; EXIT CASE "vi" ; EXIT +#endif CASE "zh-chs" ; cLangHb := "zh_sim" ; EXIT CASE "zh-cht" CASE "zh-cn" diff --git a/src/rtl/listbox.prg b/src/rtl/listbox.prg index 2183dde3e1..19ee173105 100644 --- a/src/rtl/listbox.prg +++ b/src/rtl/listbox.prg @@ -63,35 +63,65 @@ #ifdef HB_COMPAT_C53 -#define _ITEM_cTEXT 1 -#define _ITEM_cDATA 2 +#define _ITEM_cText 1 +#define _ITEM_xData 2 -#define _LISTBOX_ITEMDATA( aItem ) iif( aItem[ _ITEM_cDATA ] == NIL, aItem[ _ITEM_cTEXT ], aItem[ _ITEM_cDATA ] ) +#define _LISTBOX_ITEMDATA( aItem ) iif( aItem[ _ITEM_xData ] == NIL, aItem[ _ITEM_cText ], aItem[ _ITEM_xData ] ) CREATE CLASS ListBox FUNCTION HBListBox + PROTECTED: + + /* --- Start of CA-Cl*pper compatible instance area --- */ + VAR nBottom + VAR xBuffer + VAR cCaption INIT "" + VAR nCapCol + VAR nCapRow + VAR cargo EXPORTED + VAR cColdBox INIT HB_B_SINGLE_UNI + VAR cColorSpec + VAR aItems INIT {} + VAR lDropDown + VAR bFBlock + VAR lHasFocus INIT .F. + VAR cHotBox INIT HB_B_DOUBLE_UNI + VAR nItemCount INIT 0 + VAR nLeft + VAR cMessage INIT "" + VAR aSaveScr + VAR lIsOpen + VAR nRight + VAR bSBlock + VAR nCursor + VAR cStyle INIT Chr( 31 ) /* LOW-ASCII "▼" */ + VAR cTextValue INIT "" + VAR nTop + VAR nTopItem INIT 0 + VAR oVScroll + VAR nValue INIT 0 + VAR cBitmap INIT "dropbox.bmu" + EXPORTED: - VAR cargo - - METHOD addItem( cText, cData ) + METHOD addItem( cText, xData ) METHOD close() METHOD delItem( nPos ) METHOD display() METHOD findText( cText, nPos, lCaseSensitive, lExact ) - METHOD findData( cData, nPos, lCaseSensitive, lExact ) /* NOTE: Undocumented CA-Cl*pper method. */ + METHOD findData( xData, nPos, lCaseSensitive, lExact ) /* NOTE: Undocumented CA-Cl*pper method. */ METHOD getData( nPos ) METHOD getItem( nPos ) METHOD getText( nPos ) METHOD hitTest( nMRow, nMCol ) - METHOD insItem( nPos, cText, cData ) + METHOD insItem( nPos, cText, xData ) METHOD killFocus() METHOD nextItem() METHOD open() METHOD prevItem() METHOD scroll( nMethod ) METHOD select( xPos ) - METHOD setData( nPos, cData ) + METHOD setData( nPos, xData ) METHOD setFocus() METHOD setItem( nPos, aItem ) METHOD setText( nPos, cText ) @@ -114,57 +144,28 @@ CREATE CLASS ListBox FUNCTION HBListBox METHOD message( cMessage ) SETGET METHOD right( nRight ) SETGET METHOD sBlock( bSBlock ) SETGET - METHOD style( cStyle ) SETGET /* NOTE: Undocumented CA-Cl*pper method. */ - METHOD textValue() SETGET /* NOTE: Undocumented CA-Cl*pper method. */ + METHOD style( cStyle ) SETGET /* NOTE: Undocumented CA-Cl*pper method. */ + METHOD textValue() SETGET /* NOTE: Undocumented CA-Cl*pper method. */ METHOD top( nTop ) SETGET METHOD topItem( nTopItem ) SETGET METHOD typeOut() SETGET - METHOD value() SETGET /* NOTE: Undocumented CA-Cl*pper method. */ + METHOD value() SETGET /* NOTE: Undocumented CA-Cl*pper method. */ METHOD vScroll( oVScroll ) SETGET - METHOD New( nTop, nLeft, nBottom, nRight, lDropDown ) /* NOTE: This method is a Harbour extension [vszakats] */ + METHOD New( nTop, nLeft, nBottom, nRight, lDropDown ) /* NOTE: This method is a Harbour extension [vszakats] */ PROTECTED: - VAR cBitmap INIT "dropbox.bmu" - VAR nBottom - VAR xBuffer - VAR nCapCol - VAR nCapRow - VAR cCaption INIT "" - VAR cColdBox INIT HB_B_SINGLE_UNI - VAR cColorSpec - VAR lDropDown - VAR bFBlock - VAR lHasFocus INIT .F. - VAR cHotBox INIT HB_B_DOUBLE_UNI - VAR lIsOpen - VAR nItemCount INIT 0 - VAR nLeft - VAR cMessage INIT "" - VAR nRight - VAR bSBlock - VAR cStyle INIT Chr( 31 ) /* LOW-ASCII "▼" */ - VAR cTextValue INIT "" - VAR nTop - VAR nTopItem INIT 0 - VAR nValue INIT 0 - VAR oVScroll - - VAR aItems INIT {} - VAR aSaveScr - VAR nCursor - METHOD changeItem( nOldPos, nNewPos ) METHOD scrollbarPos() ENDCLASS -METHOD addItem( cText, cData ) CLASS ListBox +METHOD addItem( cText, xData ) CLASS ListBox - IF HB_ISSTRING( cText ) .AND. ValType( cData ) $ "CU" + IF HB_ISSTRING( cText ) - AAdd( ::aItems, { cText, cData } ) + AAdd( ::aItems, { cText, xData } ) ::nItemCount++ @@ -206,7 +207,6 @@ METHOD delItem( nPos ) CLASS ListBox ELSEIF ::nValue > 0 ::xBuffer := ::cTextValue ENDIF - ENDIF IF ::nTopItem > ::nItemCount @@ -254,7 +254,7 @@ METHOD display() CLASS ListBox IF ::lDropDown hb_DispOutAt( nTop, nLeft, ; - iif( ::nValue == 0, Space( nSize - 1 ), PadR( ::aItems[ ::nValue ][ _ITEM_cTEXT ], nSize - 1 ) ), ; + iif( ::nValue == 0, Space( nSize - 1 ), PadR( ::aItems[ ::nValue ][ _ITEM_cText ], nSize - 1 ) ), ; cColorAny ) hb_DispOutAt( nTop++, nLeft + nSize - 1, ::cStyle, hb_ColorIndex( ::cColorSpec, 7 ) ) @@ -277,7 +277,6 @@ METHOD display() CLASS ListBox nLeft++ nSize -= 2 nEnd -= 2 - ENDIF IF nEnd > ::nItemCount @@ -285,7 +284,7 @@ METHOD display() CLASS ListBox ENDIF FOR nItem := ::nTopItem TO nEnd - hb_DispOutAt( nTop++, nLeft, PadR( ::aItems[ nItem ][ _ITEM_cTEXT ], nSize ), iif( nItem == ::nValue, cColor4, cColor3 ) ) + hb_DispOutAt( nTop++, nLeft, PadR( ::aItems[ nItem ][ _ITEM_cText ], nSize ), iif( nItem == ::nValue, cColor4, cColor3 ) ) NEXT ENDIF @@ -303,7 +302,6 @@ METHOD display() CLASS ListBox IF nPos != 0 hb_DispOutAt( ::nCapRow, ::nCapCol + nPos - 2, SubStr( cCaption, nPos, 1 ), hb_ColorIndex( ::cColorSpec, 6 ) ) ENDIF - ENDIF DispEnd() @@ -313,12 +311,14 @@ METHOD display() CLASS ListBox METHOD findText( cText, nPos, lCaseSensitive, lExact ) CLASS ListBox LOCAL nPosFound - LOCAL nLen LOCAL bSearch - IF ! HB_ISSTRING( cText ) .OR. Len( cText ) == 0 +#ifndef HB_CLP_STRICT + /* NOTE: Cl*pper will RTE if passed a non-string cText */ + IF ! HB_ISSTRING( cText ) RETURN 0 ENDIF +#endif hb_default( @nPos, 1 ) hb_default( @lCaseSensitive, .T. ) @@ -327,40 +327,35 @@ METHOD findText( cText, nPos, lCaseSensitive, lExact ) CLASS ListBox ENDIF IF lExact - cText := RTrim( cText ) IF lCaseSensitive - bSearch := {| aItem | RTrim( aItem[ _ITEM_cTEXT ] ) == cText } + bSearch := {| aItem | aItem[ _ITEM_cText ] == cText } ELSE cText := Lower( cText ) - bSearch := {| aItem | Lower( RTrim( aItem[ _ITEM_cTEXT ] ) ) == cText } + bSearch := {| aItem | Lower( aItem[ _ITEM_cText ] ) == cText } ENDIF ELSE - nLen := Len( cText ) IF lCaseSensitive - bSearch := {| aItem | Left( aItem[ _ITEM_cTEXT ], nLen ) == cText } + bSearch := {| aItem | hb_LeftEq( aItem[ _ITEM_cText ], cText ) } ELSE - cText := Lower( cText ) - bSearch := {| aItem | Lower( Left( aItem[ _ITEM_cTEXT ], nLen ) ) == cText } + bSearch := {| aItem | hb_LeftEqI( aItem[ _ITEM_cText ], cText ) } ENDIF ENDIF - nPosFound := AScan( ::aItems, bSearch, nPos, Len( ::aItems ) - nPos + 1 ) - IF nPosFound == 0 .AND. nPos > 1 + IF ( nPosFound := AScan( ::aItems, bSearch, nPos, Len( ::aItems ) - nPos + 1 ) ) == 0 .AND. nPos > 1 nPosFound := AScan( ::aItems, bSearch, 1, nPos - 1 ) ENDIF RETURN nPosFound -METHOD findData( cData, nPos, lCaseSensitive, lExact ) CLASS ListBox +/* NOTE: Both Cl*pper and Harbour may RTE when searching for + a different type than present in an item value. The RTE + will be different and in Cl*pper, but will occur under + the same conditions. */ +METHOD findData( xData, nPos, lCaseSensitive, lExact ) CLASS ListBox LOCAL nPosFound - LOCAL nLen LOCAL bSearch - IF ! HB_ISSTRING( cData ) - RETURN 0 - ENDIF - hb_default( @nPos, 1 ) hb_default( @lCaseSensitive, .T. ) IF ! HB_ISLOGICAL( lExact ) @@ -368,38 +363,38 @@ METHOD findData( cData, nPos, lCaseSensitive, lExact ) CLASS ListBox ENDIF IF lExact - cData := RTrim( cData ) IF lCaseSensitive - bSearch := {| aItem | RTrim( _LISTBOX_ITEMDATA( aItem ) ) == cData } + bSearch := {| aItem | _LISTBOX_ITEMDATA( aItem ) == xData } ELSE - cData := Lower( cData ) - bSearch := {| aItem | Lower( RTrim( _LISTBOX_ITEMDATA( aItem ) ) ) == cData } + /* Cl*pper will also RTE here, if xData is not a string */ + xData := Lower( xData ) + bSearch := {| aItem | Lower( _LISTBOX_ITEMDATA( aItem ) ) == xData } ENDIF ELSE - nLen := Len( cData ) IF lCaseSensitive - bSearch := {| aItem | Left( _LISTBOX_ITEMDATA( aItem ), nLen ) == cData } + bSearch := {| aItem, xItemData | xItemData := _LISTBOX_ITEMDATA( aItem ), ; + iif( HB_ISSTRING( xItemData ), hb_LeftEq( xItemData, xData ), ; + xItemData == xData ) } ELSE - cData := Lower( cData ) - bSearch := {| aItem | Lower( Left( _LISTBOX_ITEMDATA( aItem ), nLen ) ) == cData } + /* Cl*pper will also RTE here, if xData is not a string */ + bSearch := {| aItem | hb_LeftEqI( _LISTBOX_ITEMDATA( aItem ), xData ) } ENDIF ENDIF - nPosFound := AScan( ::aItems, bSearch, nPos, Len( ::aItems ) - nPos + 1 ) - IF nPosFound == 0 .AND. nPos > 1 + IF ( nPosFound := AScan( ::aItems, bSearch, nPos, Len( ::aItems ) - nPos + 1 ) ) == 0 .AND. nPos > 1 nPosFound := AScan( ::aItems, bSearch, 1, nPos - 1 ) ENDIF RETURN nPosFound METHOD getData( nPos ) CLASS ListBox - RETURN iif( nPos >= 1 .AND. nPos <= ::nItemCount, ::aItems[ nPos ][ _ITEM_cDATA ], NIL ) + RETURN iif( nPos >= 1 .AND. nPos <= ::nItemCount, ::aItems[ nPos ][ _ITEM_xData ], NIL ) METHOD getItem( nPos ) CLASS ListBox RETURN iif( nPos >= 1 .AND. nPos <= ::nItemCount, ::aItems[ nPos ], NIL ) METHOD getText( nPos ) CLASS ListBox - RETURN iif( nPos >= 1 .AND. nPos <= ::nItemCount, ::aItems[ nPos ][ _ITEM_cTEXT ], NIL ) + RETURN iif( nPos >= 1 .AND. nPos <= ::nItemCount, ::aItems[ nPos ][ _ITEM_cText ], NIL ) METHOD hitTest( nMRow, nMCol ) CLASS ListBox @@ -485,13 +480,13 @@ METHOD hitTest( nMRow, nMCol ) CLASS ListBox RETURN 0 -METHOD insItem( nPos, cText, cData ) CLASS ListBox +METHOD insItem( nPos, cText, xData ) CLASS ListBox IF HB_ISSTRING( cText ) .AND. ; HB_ISNUMERIC( nPos ) .AND. ; nPos < ::nItemCount - hb_AIns( ::aItems, nPos, { cText, cData }, .T. ) + hb_AIns( ::aItems, nPos, { cText, xData }, .T. ) ::nItemCount++ IF ::nItemCount == 1 @@ -589,91 +584,94 @@ METHOD scroll( nMethod ) CLASS ListBox LOCAL nKey LOCAL nCount - SWITCH nMethod - CASE HTSCROLLTHUMBDRAG + IF HB_ISNUMERIC( nMethod ) - nPrevMRow := MRow() + SWITCH nMethod + CASE HTSCROLLTHUMBDRAG - DO WHILE ( ( nKey := Inkey( 0 ) ) != K_LBUTTONUP ) + nPrevMRow := MRow() - IF nKey == K_MOUSEMOVE + DO WHILE ( ( nKey := Inkey( 0 ) ) != K_LBUTTONUP ) - nMRow := MRow() + IF nKey == K_MOUSEMOVE - IF nMRow <= ::oVScroll:start() - nMRow := ::oVScroll:start() + 1 - ENDIF - IF nMRow >= ::oVScroll:end() - nMRow := ::oVScroll:end() - 1 - ENDIF + nMRow := MRow() - IF nMRow != nPrevMRow - nThumbPos := ::oVScroll:thumbPos() + ( nMRow - nPrevMRow ) - nBarLength := ::oVScroll:barLength() - nTotal := ::oVScroll:total() - nSize := Min( Max( ( nThumbPos * ( nTotal - nBarLength - 2 ) + 2 * nBarLength + 1 - nTotal ) / ( nBarLength - 1 ), 1 ), nTotal ) - nCurrent := ::oVScroll:current() - IF nSize - nCurrent > 0 - FOR nCount := 1 TO nSize - nCurrent - ::scroll( HTSCROLLUNITINC ) - NEXT - ELSE - FOR nCount := 1 TO nCurrent - nSize - ::scroll( HTSCROLLUNITDEC ) - NEXT + IF nMRow <= ::oVScroll:start() + nMRow := ::oVScroll:start() + 1 + ENDIF + IF nMRow >= ::oVScroll:end() + nMRow := ::oVScroll:end() - 1 ENDIF - nPrevMRow := nMRow + IF nMRow != nPrevMRow + nThumbPos := ::oVScroll:thumbPos() + ( nMRow - nPrevMRow ) + nBarLength := ::oVScroll:barLength() + nTotal := ::oVScroll:total() + nSize := Min( Max( ( nThumbPos * ( nTotal - nBarLength - 2 ) + 2 * nBarLength + 1 - nTotal ) / ( nBarLength - 1 ), 1 ), nTotal ) + nCurrent := ::oVScroll:current() + IF nSize - nCurrent > 0 + FOR nCount := 1 TO nSize - nCurrent + ::scroll( HTSCROLLUNITINC ) + NEXT + ELSE + FOR nCount := 1 TO nCurrent - nSize + ::scroll( HTSCROLLUNITDEC ) + NEXT + ENDIF + + nPrevMRow := nMRow + ENDIF ENDIF + ENDDO + EXIT + + CASE HTSCROLLUNITDEC + + IF ::nTopItem > 1 + ::nTopItem-- + ::oVScroll:current := ::scrollbarPos() + ::display() ENDIF - ENDDO - EXIT + EXIT - CASE HTSCROLLUNITDEC + CASE HTSCROLLUNITINC - IF ::nTopItem > 1 - ::nTopItem-- - ::oVScroll:current := ::scrollbarPos() - ::display() - ENDIF - EXIT - - CASE HTSCROLLUNITINC - - IF ( ::nTopItem + ::nBottom - ::nTop ) <= ::nItemCount + 1 - ::nTopItem++ - ::oVScroll:current := ::scrollbarPos() - ::display() - ENDIF - EXIT - - CASE HTSCROLLBLOCKDEC - - nPos := ::nBottom - ::nTop - iif( ::lDropDown, 2, 1 ) - nTopItem := ::nTopItem - nPos - IF ::nTopItem > 1 - ::nTopItem := Max( nTopItem, 1 ) - ::oVScroll:current := ::scrollbarPos() - ::display() - ENDIF - EXIT - - CASE HTSCROLLBLOCKINC - - nPos := ::nBottom - ::nTop - 1 - nItemCount := ::nItemCount - nTopItem := ::nTopItem + nPos - IF ::nTopItem < nItemCount - nPos + 1 - IF nTopItem + nPos - 1 > nItemCount - nTopItem := nItemCount - nPos + 1 + IF ( ::nTopItem + ::nBottom - ::nTop ) <= ::nItemCount + 1 + ::nTopItem++ + ::oVScroll:current := ::scrollbarPos() + ::display() ENDIF - ::nTopItem := nTopItem - ::oVScroll:current := ::scrollbarPos() - ::display() - ENDIF - EXIT + EXIT - ENDSWITCH + CASE HTSCROLLBLOCKDEC + + nPos := ::nBottom - ::nTop - iif( ::lDropDown, 2, 1 ) + nTopItem := ::nTopItem - nPos + IF ::nTopItem > 1 + ::nTopItem := Max( nTopItem, 1 ) + ::oVScroll:current := ::scrollbarPos() + ::display() + ENDIF + EXIT + + CASE HTSCROLLBLOCKINC + + nPos := ::nBottom - ::nTop - 1 + nItemCount := ::nItemCount + nTopItem := ::nTopItem + nPos + IF ::nTopItem < nItemCount - nPos + 1 + IF nTopItem + nPos - 1 > nItemCount + nTopItem := nItemCount - nPos + 1 + ENDIF + ::nTopItem := nTopItem + ::oVScroll:current := ::scrollbarPos() + ::display() + ENDIF + EXIT + + ENDSWITCH + ENDIF RETURN Self @@ -715,9 +713,7 @@ METHOD select( xPos ) CLASS ListBox ::cTextValue := iif( nPos == 0, "", _LISTBOX_ITEMDATA( ::aItems[ nPos ] ) ) - nPos := iif( Empty( ::cHotBox + ::cColdBox ), 0, 2 ) - - nValue := ::nValue - ( ::nBottom - ::nTop - nPos ) + nValue := ::nValue - ( ::nBottom - ::nTop - iif( Empty( ::cHotBox + ::cColdBox ), 0, 2 ) ) IF ::nTopItem <= nValue ::nTopItem := nValue IF ::oVScroll != NIL @@ -738,10 +734,11 @@ METHOD select( xPos ) CLASS ListBox RETURN ::nValue -METHOD setData( nPos, cData ) CLASS ListBox +/* NOTE: This function does nothing in Cl*pper, due to a bug. */ +METHOD setData( nPos, xData ) CLASS ListBox IF nPos >= 1 .AND. nPos <= ::nItemCount - ::aItems[ nPos ][ _ITEM_cDATA ] := cData + ::aItems[ nPos ][ _ITEM_xData ] := xData ENDIF RETURN Self @@ -758,7 +755,6 @@ METHOD setFocus() CLASS ListBox IF HB_ISEVALITEM( ::bFBlock ) Eval( ::bFBlock ) ENDIF - ENDIF RETURN Self @@ -767,7 +763,7 @@ METHOD setItem( nPos, aItem ) CLASS ListBox IF nPos >= 1 .AND. nPos <= ::nItemCount .AND. ; Len( aItem ) == 2 .AND. ; - HB_ISSTRING( aItem[ _ITEM_cTEXT ] ) + HB_ISSTRING( aItem[ _ITEM_cText ] ) ::aItems[ nPos ] := aItem ENDIF @@ -777,7 +773,7 @@ METHOD setItem( nPos, aItem ) CLASS ListBox METHOD setText( nPos, cText ) CLASS ListBox IF nPos >= 1 .AND. nPos <= ::nItemCount - ::aItems[ nPos ][ _ITEM_cTEXT ] := cText + ::aItems[ nPos ][ _ITEM_cText ] := cText ENDIF RETURN Self @@ -1088,13 +1084,10 @@ FUNCTION ListBox( nTop, nLeft, nBottom, nRight, lDropDown ) FUNCTION _LISTBOX_( nTop, nLeft, nBottom, nRight, xPos, aItems, cCaption, ; cMessage, cColorSpec, bFBlock, bSBlock, lDropDown, lScrollBar, cBitmap ) - LOCAL o := HBListBox():New( nTop, nLeft, nBottom, nRight, lDropDown ) - - LOCAL nPos - LOCAL nLen + LOCAL o LOCAL xItem - IF o != NIL + IF ( o := HBListBox():New( nTop, nLeft, nBottom, nRight, lDropDown ) ) != NIL IF HB_ISSTRING( cCaption ) o:caption := cCaption @@ -1106,22 +1099,18 @@ FUNCTION _LISTBOX_( nTop, nLeft, nBottom, nRight, xPos, aItems, cCaption, ; o:fBlock := bFBlock o:sBlock := bSBlock - nLen := Len( aItems ) - FOR nPos := 1 TO nLen - - xItem := aItems[ nPos ] - + FOR EACH xItem IN aItems IF ! HB_ISARRAY( xItem ) o:addItem( xItem ) - ELSEIF Len( xItem ) == _ITEM_cTEXT - o:addItem( xItem[ _ITEM_cTEXT ] ) + ELSEIF Len( xItem ) == _ITEM_cText + o:addItem( xItem[ _ITEM_cText ] ) ELSE - o:addItem( xItem[ _ITEM_cTEXT ], xItem[ _ITEM_cDATA ] ) + o:addItem( xItem[ _ITEM_cText ], xItem[ _ITEM_xData ] ) ENDIF NEXT - IF HB_ISLOGICAL( lScrollBar ) .AND. lScrollBar - IF HB_ISLOGICAL( lDropDown ) .AND. lDropDown + IF hb_defaultValue( lScrollBar, .F. ) + IF hb_defaultValue( lDropDown, .F. ) nTop++ ENDIF o:VScroll := ScrollBar( nTop + 1, nBottom - 1, nRight ) diff --git a/src/rtl/memoedit.prg b/src/rtl/memoedit.prg index f6d8456188..29ffba9a5b 100644 --- a/src/rtl/memoedit.prg +++ b/src/rtl/memoedit.prg @@ -65,31 +65,41 @@ CREATE CLASS HBMemoEditor INHERIT HBEditor METHOD KeyboardHook( nKey ) // Gets called every time there is a key not handled directly by HBEditor METHOD IdleHook() // Gets called every time there are no more keys to hanlde - METHOD HandleUserKey( nKey, nUserKey ) // Handles keys returned to MemoEdit() by user function + METHOD HandleUserKey( nKey, nUdfReturn ) // Handles keys returned to MemoEdit() by user function METHOD xDo( nStatus ) // Calls xUserFunction saving and restoring cursor position and shape METHOD MoveCursor( nKey ) // Redefined to properly managed CTRL-W + PROTECTED: + + METHOD UserFunctionIsValid() + ENDCLASS +METHOD UserFunctionIsValid() CLASS HBMemoEditor +#ifdef HB_CLP_STRICT + RETURN HB_ISSTRING( ::xUserFunction ) +#else + RETURN HB_ISSTRING( ::xUserFunction ) .OR. HB_ISEVALITEM( ::xUserFunction ) +#endif + METHOD MemoInit( xUserFunction ) CLASS HBMemoEditor - LOCAL nKey + LOCAL nUdfReturn // Save/Init object internal representation of user function ::xUserFunction := xUserFunction - IF HB_ISSTRING( ::xUserFunction ) + IF ::UserFunctionIsValid() + // Keep calling user function until it returns ME_DEFAULT - DO WHILE ( nKey := ::xDo( ME_INIT ) ) != ME_DEFAULT - + DO WHILE ( nUdfReturn := ::xDo( ME_INIT ) ) != ME_DEFAULT // At this time there is no input from user of MemoEdit() only handling - // of values returned by ::xUserFunction, so I pass these value on both - // parameters of ::HandleUserKey() - ::HandleUserKey( nKey, nKey ) - + // of values returned by ::xUserFunction, so I pass NIL as the key code. + IF ! ::HandleUserKey( , nUdfReturn ) + EXIT + ENDIF ENDDO - ENDIF RETURN Self @@ -98,14 +108,14 @@ METHOD Edit() CLASS HBMemoEditor LOCAL nKey - // NOTE: K_ALT_W is not compatible with clipper exit memo and save key, but I cannot discriminate - // K_CTRL_W and K_CTRL_END from harbour code. + // NOTE: K_ALT_W is not compatible with Cl*pper exit memo and save key, but I cannot discriminate + // K_CTRL_W and K_CTRL_END from Harbour code. LOCAL aConfigurableKeys := { K_CTRL_Y, K_CTRL_T, K_CTRL_B, K_CTRL_V, K_ALT_W, K_ESC } LOCAL bKeyBlock // If I have an user function I need to trap configurable keys and ask to // user function if handle them the standard way or not - IF ::lEditAllow .AND. HB_ISSTRING( ::xUserFunction ) + IF ::lEditAllow .AND. ::UserFunctionIsValid() DO WHILE ! ::lExitEdit @@ -121,9 +131,11 @@ METHOD Edit() CLASS HBMemoEditor LOOP ENDIF - // Is it a configurable key ? + // Is it a configurable key? IF AScan( aConfigurableKeys, nKey ) > 0 - ::HandleUserKey( nKey, ::xDo( iif( ::lDirty, ME_UNKEYX, ME_UNKEY ) ) ) + IF ::HandleUserKey( nKey, ::xDo( iif( ::lDirty, ME_UNKEYX, ME_UNKEY ) ) ) + + ENDIF ELSE ::super:Edit( nKey ) ENDIF @@ -145,36 +157,35 @@ METHOD KeyboardHook( nKey ) CLASS HBMemoEditor LOCAL nRow LOCAL nCol - IF HB_ISSTRING( ::xUserFunction ) - IF ! ::lCallKeyboardHook // To avoid recursive calls in endless loop. [jarabal] - ::lCallKeyboardHook := .T. - ::HandleUserKey( nKey, ::xDo( iif( ::lDirty, ME_UNKEYX, ME_UNKEY ) ) ) - ::lCallKeyboardHook := .F. - ENDIF - ELSE - IF nKey == K_ESC - IF ::lDirty .AND. Set( _SET_SCOREBOARD ) - cBackScr := SaveScreen( 0, MaxCol() - 18, 0, MaxCol() ) + IF ::UserFunctionIsValid() .AND. ! ::lCallKeyboardHook // To avoid recursive calls in endless loop. [jarabal] - nRow := Row() - nCol := Col() - hb_DispOutAt( 0, MaxCol() - 18, "Abort Edit? (Y/N)" ) - SetPos( 0, MaxCol() - 1 ) + ::lCallKeyboardHook := .T. + ::HandleUserKey( nKey, ::xDo( iif( ::lDirty, ME_UNKEYX, ME_UNKEY ) ) ) + ::lCallKeyboardHook := .F. - nYesNoKey := Inkey( 0 ) + ELSEIF nKey == K_ESC - RestScreen( 0, MaxCol() - 18, 0, MaxCol(), cBackScr ) - SetPos( nRow, nCol ) + IF ::lDirty .AND. Set( _SET_SCOREBOARD ) + cBackScr := SaveScreen( 0, MaxCol() - 18, 0, MaxCol() ) - IF nYesNoKey == Asc( "Y" ) .OR. nYesNoKey == Asc( "y" ) - hb_keySetLast( K_ESC ) /* Cl*pper compatibility */ - ::lSaved := .F. - ::lExitEdit := .T. - ENDIF - ELSE + nRow := Row() + nCol := Col() + hb_DispOutAt( 0, MaxCol() - 18, "Abort Edit? (Y/N)" ) + SetPos( 0, MaxCol() - 1 ) + + nYesNoKey := Inkey( 0 ) + + RestScreen( 0, MaxCol() - 18, 0, MaxCol(), cBackScr ) + SetPos( nRow, nCol ) + + IF Upper( hb_keyChar( nYesNoKey ) ) == "Y" + hb_keySetLast( K_ESC ) /* Cl*pper compatibility */ ::lSaved := .F. ::lExitEdit := .T. ENDIF + ELSE + ::lSaved := .F. + ::lExitEdit := .T. ENDIF ENDIF @@ -182,59 +193,71 @@ METHOD KeyboardHook( nKey ) CLASS HBMemoEditor METHOD IdleHook() CLASS HBMemoEditor - IF HB_ISSTRING( ::xUserFunction ) + IF ::UserFunctionIsValid() ::xDo( ME_IDLE ) ENDIF RETURN Self -METHOD HandleUserKey( nKey, nUserKey ) CLASS HBMemoEditor +METHOD HandleUserKey( nKey, nUdfReturn ) CLASS HBMemoEditor DO CASE - // I won't reach this point during ME_INIT since ME_DEFAULT ends initialization phase of MemoEdit() - CASE nUserKey == ME_DEFAULT + CASE nUdfReturn == ME_DEFAULT - // HBEditor is not able to handle keys with a value higher than 256, but I have to tell him - // that user wants to save text - DO CASE - CASE nKey == K_ESC - ::lSaved := .F. - ::lExitEdit := .T. - CASE nKey <= 256 .OR. nKey == K_ALT_W - ::super:Edit( nKey ) - ENDCASE + // I won't reach this point during ME_INIT since ME_DEFAULT ends initialization phase of MemoEdit() - // TOFIX: Not CA-Cl*pper compatible, see teditor.prg - CASE ( nUserKey >= 1 .AND. nUserKey <= 31 ) .OR. nUserKey == K_ALT_W - ::super:Edit( nUserKey ) - - CASE nUserKey == ME_DATA - IF nKey <= 256 - ::super:Edit( nKey ) + IF HB_ISNUMERIC( nKey ) + // HBEditor is not able to handle keys with a value higher than 256, but I have to tell him + // that user wants to save text + DO CASE + CASE nKey == K_ESC + ::lSaved := .F. + ::lExitEdit := .T. + CASE nKey <= 256 .OR. nKey == K_ALT_W + ::super:Edit( nKey ) + ENDCASE + ELSE + RETURN .F. ENDIF - CASE nUserKey == ME_TOGGLEWRAP + CASE nUdfReturn == ME_DATA + IF HB_ISNUMERIC( nKey ) + IF nKey <= 256 + ::super:Edit( nKey ) + ENDIF + ELSE + RETURN .F. + ENDIF + + CASE nUdfReturn == ME_TOGGLEWRAP ::lWordWrap := ! ::lWordWrap - CASE nUserKey == ME_TOGGLESCROLL + CASE nUdfReturn == ME_TOGGLESCROLL // TODO: HBEditor does not support vertical scrolling of text inside window without moving cursor position - CASE nUserKey == ME_WORDRIGHT + CASE nUdfReturn == ME_WORDRIGHT ::MoveCursor( K_CTRL_RIGHT ) - CASE nUserKey == ME_BOTTOMRIGHT + CASE nUdfReturn == ME_BOTTOMRIGHT ::MoveCursor( K_CTRL_END ) #ifndef HB_CLP_STRICT - CASE nUserKey == ME_PASTE /* Xbase++ compatibility */ + CASE nUdfReturn == ME_PASTE /* Xbase++ compatibility */ hb_gtInfo( HB_GTI_CLIPBOARDPASTE ) #endif - OTHERWISE - // Do nothing + CASE nUdfReturn != ME_IGNORE + + // TOFIX: Not CA-Cl*pper compatible, see teditor.prg + IF HB_ISNUMERIC( nKey ) .AND. ( ( nKey >= 1 .AND. nKey <= 31 ) .OR. nKey == K_ALT_W ) + ::super:Edit( nKey ) + ELSE + RETURN .F. + ENDIF + ENDCASE - RETURN Self + RETURN .T. METHOD xDo( nStatus ) CLASS HBMemoEditor @@ -244,12 +267,10 @@ METHOD xDo( nStatus ) CLASS HBMemoEditor LOCAL xResult := Do( ::xUserFunction, nStatus, ::nRow, ::nCol - 1 ) - hb_default( @xResult, ME_DEFAULT ) - ::SetPos( nOldRow, nOldCol ) SetCursor( nOldCur ) - RETURN xResult + RETURN hb_defaultValue( xResult, ME_DEFAULT ) METHOD MoveCursor( nKey ) CLASS HBMemoEditor @@ -259,7 +280,7 @@ METHOD MoveCursor( nKey ) CLASS HBMemoEditor ::lSaved := .T. ::lExitEdit := .T. ELSE - RETURN ::Super:MoveCursor( nKey ) + RETURN ::super:MoveCursor( nKey ) ENDIF RETURN .F. @@ -267,43 +288,50 @@ METHOD MoveCursor( nKey ) CLASS HBMemoEditor /* ------------------------------------------ */ FUNCTION MemoEdit( ; - cString,; - nTop,; - nLeft,; - nBottom,; - nRight,; - lEditMode,; - xUserFunction,; - nLineLength,; - nTabSize,; - nTextBuffRow,; - nTextBuffColumn,; - nWindowRow,; + cString, ; + nTop, ; + nLeft, ; + nBottom, ; + nRight, ; + lEditMode, ; + xUserFunction, ; + nLineLength, ; + nTabSize, ; + nTextBuffRow, ; + nTextBuffColumn, ; + nWindowRow, ; nWindowColumn ) LOCAL oEd LOCAL nOldCursor - hb_default( @nTop , 0 ) - hb_default( @nLeft , 0 ) - hb_default( @nBottom , MaxRow() ) - hb_default( @nRight , MaxCol() ) - hb_default( @lEditMode , .T. ) + hb_default( @nLeft , 0 ) + hb_default( @nRight , MaxCol() ) hb_default( @nLineLength , nRight - nLeft + 1 ) - hb_default( @nTabSize , 4 ) - hb_default( @nTextBuffRow , 1 ) - hb_default( @nTextBuffColumn , 0 ) - hb_default( @nWindowRow , 0 ) - hb_default( @nWindowColumn , nTextBuffColumn ) - hb_default( @cString , "" ) + hb_default( @nTextBuffColumn , 0 ) + hb_default( @nWindowColumn , nTextBuffColumn ) + hb_default( @cString , "" ) - // Original MemoEdit() converts Tabs into spaces; - oEd := HBMemoEditor():New( StrTran( cString, Chr( 9 ), Space( 1 ) ), nTop, nLeft, nBottom, nRight, lEditMode, nLineLength, nTabSize, nTextBuffRow, nTextBuffColumn, nWindowRow, nWindowColumn ) + /* Original MemoEdit() converts tabs into spaces */ + oEd := HBMemoEditor():New( StrTran( cString, Chr( 9 ), Space( 1 ) ), ; + hb_defaultValue( nTop, 0 ), ; + nLeft, ; + hb_defaultValue( nBottom, MaxRow() ), ; + nRight, ; + hb_defaultValue( lEditMode, .T. ), ; + nLineLength, ; + hb_defaultValue( nTabSize, 4 ), ; + hb_defaultValue( nTextBuffRow, 1 ), ; + nTextBuffColumn, ; + hb_defaultValue( nWindowRow, 0 ), ; + nWindowColumn ) oEd:MemoInit( xUserFunction ) oEd:display() - IF ! HB_ISLOGICAL( xUserFunction ) .OR. xUserFunction + /* Contrary to what the NG says, any logical value will make it pass + through without any editing. */ + IF ! HB_ISLOGICAL( xUserFunction ) nOldCursor := SetCursor( iif( Set( _SET_INSERT ), SC_INSERT, SC_NORMAL ) ) oEd:Edit() IF oEd:Changed() .AND. oEd:Saved() diff --git a/src/rtl/teditor.prg b/src/rtl/teditor.prg index 1420ec4916..33f3b8dba5 100644 --- a/src/rtl/teditor.prg +++ b/src/rtl/teditor.prg @@ -57,6 +57,9 @@ #include "inkey.ch" #include "setcurs.ch" +/* TOFIX: Leave this here, until this code is cleaned off of RTEs */ +#pragma linenumber=on + CREATE CLASS HBEditor EXPORTED: @@ -206,7 +209,7 @@ METHOD LoadFile( cFileName ) CLASS HBEditor cString := "" ENDIF - ::aText := Text2Array( cString, iif( ::lWordWrap, ::nNumCols, NIL ) ) + ::aText := Text2Array( cString, iif( ::lWordWrap, ::nNumCols, ) ) ::naTextLen := Len( ::aText ) IF ::naTextLen == 0 @@ -221,7 +224,7 @@ METHOD LoadFile( cFileName ) CLASS HBEditor METHOD LoadText( cString ) CLASS HBEditor - ::aText := Text2Array( cString, iif( ::lWordWrap, ::nNumCols, NIL ) ) + ::aText := Text2Array( cString, iif( ::lWordWrap, ::nNumCols, ) ) ::naTextLen := Len( ::aText ) IF ::naTextLen == 0 @@ -237,14 +240,11 @@ METHOD LoadText( cString ) CLASS HBEditor // Saves file being edited, if there is no file name does nothing, returns .T. if OK METHOD SaveFile() CLASS HBEditor - IF ! Empty( ::cFile ) - - ::lDirty := ! hb_MemoWrit( ::cFile, ::GetText() ) - - RETURN ! ::lDirty + IF Empty( ::cFile ) + RETURN .F. ENDIF - RETURN .F. + RETURN ! ::lDirty := ! hb_MemoWrit( ::cFile, ::GetText() ) // Add a new Line of text at end of current text METHOD AddLine( cLine, lSoftCR ) CLASS HBEditor @@ -257,17 +257,16 @@ METHOD AddLine( cLine, lSoftCR ) CLASS HBEditor // Insert a line of text at a defined row METHOD InsertLine( cLine, lSoftCR, nRow ) CLASS HBEditor - ::AddLine() - AIns( ::aText, nRow ) - ::aText[ nRow ] := HBTextLine():New( cLine, lSoftCR ) + hb_AIns( ::aText, nRow, HBTextLine():New( cLine, lSoftCR ), .T. ) + ::naTextLen++ RETURN Self // Remove a line of text METHOD RemoveLine( nRow ) CLASS HBEditor - ADel( ::aText, nRow ) - ASize( ::aText, --::naTextLen ) + hb_ADel( ::aText, nRow, .T. ) + ::naTextLen-- RETURN Self @@ -277,7 +276,9 @@ METHOD GetLine( nRow ) CLASS HBEditor // Return text length of line n METHOD LineLen( nRow ) CLASS HBEditor - RETURN Len( ::aText[ nRow ]:cText ) + /* TOFIX: bounds checking as a workaround for RTE in: + HBEDITOR:LINELEN < HBEDITOR:MOVECURSOR < HBEDITOR:SPLITLINE < HBEDITOR:EDIT */ + RETURN iif( nRow >= 1 .AND. nRow <= Len( ::aText ), Len( ::aText[ nRow ]:cText ), 0 ) // Converts an array of text lines to a String METHOD GetText() CLASS HBEditor @@ -300,14 +301,14 @@ METHOD GotoLine( nRow ) CLASS HBEditor IF nRow <= ::naTextLen .AND. nRow > 0 - // Back one line - IF ::nRow - nRow == 1 - ::MoveCursor( K_UP ) - - ELSEIF ::nRow - nRow == -1 + SWITCH ::nRow - nRow + CASE 1 + ::MoveCursor( K_UP ) // Back one line + EXIT + CASE -1 ::MoveCursor( K_DOWN ) - - ELSE + EXIT + OTHERWISE // I need to move cursor if is past requested line number and if requested line is // inside first screen of text otherwise ::nFirstRow would be wrong IF ::nFirstRow > 1 @@ -322,12 +323,12 @@ METHOD GotoLine( nRow ) CLASS HBEditor ::nRow := nRow - IF ! ( ::nFirstRow == 1 .AND. nRow <= ::nNumRows ) + IF !( ::nFirstRow == 1 .AND. nRow <= ::nNumRows ) ::nFirstRow := Max( 1, nRow - ( ::Row() - ::nTop ) ) ENDIF ::display() - ENDIF + ENDSWITCH ENDIF RETURN Self @@ -341,7 +342,7 @@ METHOD SplitLine( nRow ) CLASS HBEditor LOCAL nFirstSpace LOCAL cLine - LOCAL cSplittedLine + LOCAL cSplitLine LOCAL nStartRow LOCAL nOCol LOCAL nORow @@ -374,21 +375,21 @@ METHOD SplitLine( nRow ) CLASS HBEditor // If there is a space before beginning of line split there IF nFirstSpace > 1 - cSplittedLine := Left( cLine, nFirstSpace ) + cSplitLine := Left( cLine, nFirstSpace ) ELSE // else split at current cursor position - cSplittedLine := Left( cLine, ::nCol - 1 ) + cSplitLine := Left( cLine, ::nCol - 1 ) ENDIF - ::InsertLine( cSplittedLine, .T., nStartRow++ ) + ::InsertLine( cSplitLine, .T., nStartRow++ ) ELSE // remainder of line - cSplittedLine := cLine - ::InsertLine( cSplittedLine, .F., nStartRow++ ) + cSplitLine := cLine + ::InsertLine( cSplitLine, .F., nStartRow++ ) ENDIF - cLine := Right( cLine, Len( cLine ) - Len( cSplittedLine ) ) + cLine := Right( cLine, Len( cLine ) - Len( cSplitLine ) ) ENDDO IF lMoveToNextLine @@ -469,8 +470,6 @@ METHOD LineColor( nRow ) CLASS HBEditor // Handles cursor movements inside text array METHOD MoveCursor( nKey ) CLASS HBEditor - LOCAL lMoveKey := .T. - SWITCH nKey CASE K_DOWN IF ! ::lEditAllow @@ -647,11 +646,10 @@ METHOD MoveCursor( nKey ) CLASS HBEditor EXIT OTHERWISE - lMoveKey := .F. - + RETURN .F. ENDSWITCH - RETURN lMoveKey + RETURN .T. // Changes insert state and insertion / overstrike mode of editor METHOD InsertState( lInsState ) CLASS HBEditor @@ -675,9 +673,7 @@ METHOD Edit( nPassedKey ) CLASS HBEditor LOCAL bKeyBlock LOCAL lSingleKeyProcess := .F. // .T. if I have to process passed key and then exit - IF ! ::lEditAllow - ::BrowseText( nPassedKey ) - ELSE + IF ::lEditAllow // If user pressed an exiting key (K_ESC or K_ALT_W) or I've received a key to handle and then exit DO WHILE ! ::lExitEdit .AND. ! lSingleKeyProcess @@ -709,7 +705,7 @@ METHOD Edit( nPassedKey ) CLASS HBEditor ::aText[ ::nRow ]:cText += Space( ::nCol - ::LineLen( ::nRow ) ) ENDIF // insert char if in insert mode or at end of current line - IF Set( _SET_INSERT ) .OR. ( ::nCol > ::LineLen( ::nRow ) ) + IF Set( _SET_INSERT ) .OR. ::nCol > ::LineLen( ::nRow ) ::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, ::nCol, 0, cKey ) ELSE ::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, ::nCol, 1, cKey ) @@ -766,7 +762,7 @@ METHOD Edit( nPassedKey ) CLASS HBEditor CASE nKey == K_TAB // insert char if in insert mode or at end of current line - IF Set( _SET_INSERT ) .OR. ( ::nCol == ::LineLen( ::nRow ) ) + IF Set( _SET_INSERT ) .OR. ::nCol == ::LineLen( ::nRow ) ::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, ::nCol, 0, Space( ::nTabWidth ) ) ::lDirty := .T. ENDIF @@ -827,6 +823,8 @@ METHOD Edit( nPassedKey ) CLASS HBEditor ::KeyboardHook( nKey ) ENDCASE ENDDO + ELSE + ::BrowseText( nPassedKey ) ENDIF RETURN Self @@ -937,7 +935,7 @@ METHOD hitTest( nMRow, nMCol ) CLASS HBEditor /* -------------------------------------------- */ // Rebuild a long line from multiple short ones (wrapped at soft CR) -METHOD GetParagraph( nRow ) +METHOD GetParagraph( nRow ) CLASS HBEditor LOCAL cLine := "" @@ -958,7 +956,7 @@ METHOD GetParagraph( nRow ) // if editing isn't allowed we enter this loop which // handles only movement keys and discards all the others -METHOD BrowseText( nPassedKey ) +METHOD BrowseText( nPassedKey ) CLASS HBEditor LOCAL nKey LOCAL bKeyBlock @@ -982,16 +980,13 @@ METHOD BrowseText( nPassedKey ) IF nKey == K_ESC ::lExitEdit := .T. - ELSE - IF ! ::MoveCursor( nKey ) - ::KeyboardHook( nKey ) - ENDIF + ELSEIF ! ::MoveCursor( nKey ) + ::KeyboardHook( nKey ) ENDIF IF nPassedKey != NIL EXIT ENDIF - ENDDO RETURN Self @@ -1000,25 +995,15 @@ METHOD BrowseText( nPassedKey ) METHOD New( cString, nTop, nLeft, nBottom, nRight, lEditMode, nLineLength, nTabSize, nTextRow, nTextCol, nWndRow, nWndCol ) CLASS HBEditor - hb_default( @cString , "" ) - hb_default( @nTop , 0 ) - hb_default( @nLeft , 0 ) - hb_default( @nBottom , MaxRow() ) - hb_default( @nRight , MaxCol() ) - hb_default( @lEditMode , .T. ) - hb_default( @nTextRow , 1 ) - hb_default( @nTextCol , 0 ) - hb_default( @nWndRow , 0 ) - hb_default( @nWndCol , 0 ) - - IF ! HB_ISNUMERIC( nLineLength ) + // is word wrap required? + IF HB_ISNUMERIC( nLineLength ) + ::lWordWrap := .T. + ::nWordWrapCol := nLineLength + ELSE nLineLength := NIL ENDIF - IF ! HB_ISNUMERIC( nTabSize ) - nTabSize := NIL - ENDIF - ::aText := Text2Array( cString, nLineLength ) + ::aText := Text2Array( hb_defaultValue( cString, "" ), nLineLength ) ::naTextLen := Len( ::aText ) IF ::naTextLen == 0 @@ -1027,10 +1012,10 @@ METHOD New( cString, nTop, nLeft, nBottom, nRight, lEditMode, nLineLength, nTabS ENDIF // editor window boundaries - ::nTop := nTop - ::nLeft := nLeft - ::nBottom := nBottom - ::nRight := nRight + ::nTop := nTop := hb_defaultValue( nTop, 0 ) + ::nLeft := nLeft := hb_defaultValue( nLeft, 0 ) + ::nBottom := nBottom := hb_defaultValue( nBottom, MaxRow() ) + ::nRight := nRight := hb_defaultValue( nRight, MaxCol() ) ::cColorSpec := SetColor() @@ -1038,15 +1023,7 @@ METHOD New( cString, nTop, nLeft, nBottom, nRight, lEditMode, nLineLength, nTabS ::nNumCols := nRight - nLeft + 1 ::nNumRows := nBottom - nTop + 1 - IF HB_ISLOGICAL( lEditMode ) - ::lEditAllow := lEditMode - ENDIF - - // is word wrap required? - IF HB_ISNUMERIC( nLineLength ) - ::lWordWrap := .T. - ::nWordWrapCol := nLineLength - ENDIF + ::lEditAllow := hb_defaultValue( lEditMode, .T. ) // how many spaces for each tab? IF HB_ISNUMERIC( nTabSize ) @@ -1054,10 +1031,10 @@ METHOD New( cString, nTop, nLeft, nBottom, nRight, lEditMode, nLineLength, nTabS ENDIF // textrow/col, wndrow/col management - nTextRow := Max( 1, nTextRow ) - nTextCol := Max( 0, nTextCol ) - nWndRow := Max( 0, nWndRow ) - nWndCol := Max( 0, nWndCol ) + nTextRow := Max( 1, hb_defaultValue( nTextRow, 1 ) ) + nTextCol := Max( 0, hb_defaultValue( nTextCol, 0 ) ) + nWndRow := Max( 0, hb_defaultValue( nWndRow, 0 ) ) + nWndCol := Max( 0, hb_defaultValue( nWndCol, 0 ) ) ::nFirstRow := Max( 1, nTextRow - nWndRow ) ::nFirstCol := nTextCol - nWndCol + 1 @@ -1117,7 +1094,7 @@ STATIC FUNCTION Text2Array( cString, nWordWrapCol ) LOCAL cLine LOCAL nFirstSpace - LOCAL cSplittedLine + LOCAL cSplitLine DO WHILE nRetLen < ncSLen @@ -1137,29 +1114,23 @@ STATIC FUNCTION Text2Array( cString, nWordWrapCol ) ENDDO IF nFirstSpace > 1 - cSplittedLine := Left( cLine, nFirstSpace ) + cSplitLine := Left( cLine, nFirstSpace ) ELSE - cSplittedLine := Left( cLine, nWordWrapCol ) + cSplitLine := Left( cLine, nWordWrapCol ) ENDIF - AAdd( aArray, HBTextLine():New( cSplittedLine, .T. ) ) - + AAdd( aArray, HBTextLine():New( cSplitLine, .T. ) ) ELSE - // remainder of line is shorter than split point - cSplittedLine := cLine - AAdd( aArray, HBTextLine():New( cSplittedLine, .F. ) ) - + cSplitLine := cLine + AAdd( aArray, HBTextLine():New( cSplitLine, .F. ) ) ENDIF - cLine := Right( cLine, Len( cLine ) - Len( cSplittedLine ) ) + cLine := Right( cLine, Len( cLine ) - Len( cSplitLine ) ) ENDDO - ELSE AAdd( aArray, HBTextLine():New( cLine, .F. ) ) - ENDIF - ENDDO RETURN aArray diff --git a/src/rtl/tget.prg b/src/rtl/tget.prg index f4a9ce0462..759e72ece1 100644 --- a/src/rtl/tget.prg +++ b/src/rtl/tget.prg @@ -985,11 +985,9 @@ METHOD setPos( nPos ) CLASS Get ::typeOut := .T. ENDCASE - ENDIF RETURN nPos - ENDIF RETURN 0 @@ -1025,9 +1023,7 @@ METHOD picture( cPicture ) CLASS Get IF hb_LeftEq( cPicture, "@" ) - nAt := At( " ", cPicture ) - - IF nAt == 0 + IF ( nAt := At( " ", cPicture ) ) == 0 ::cPicFunc := hb_asciiUpper( cPicture ) ::cPicMask := "" ELSE @@ -1377,7 +1373,6 @@ METHOD unTransform() CLASS Get RETURN xValue METHOD type() CLASS Get - RETURN ::cType := ValType( iif( ::hasFocus, ::xVarGet, ::varGet() ) ) /* The METHOD Block and VAR bBlock allow to replace the @@ -1416,7 +1411,6 @@ METHOD firstEditable() CLASS Get RETURN nFor ENDIF NEXT - ENDIF RETURN 0 @@ -1432,7 +1426,6 @@ METHOD lastEditable() CLASS Get RETURN nFor ENDIF NEXT - ENDIF RETURN 0 @@ -1652,19 +1645,24 @@ METHOD DeleteAll() CLASS Get ::lEdit := .T. - DO CASE - CASE ::cType == "C" + SWITCH ::cType + CASE "C" xValue := Space( ::nMaxlen ) - CASE ::cType == "N" + EXIT + CASE "N" xValue := 0 ::lMinus2 := .F. - CASE ::cType == "D" + EXIT + CASE "D" xValue := hb_SToD() - CASE ::cType == "T" + EXIT + CASE "T" xValue := hb_SToT() - CASE ::cType == "L" + EXIT + CASE "L" xValue := .F. - ENDCASE + EXIT + ENDSWITCH ::cBuffer := ::PutMask( xValue ) ::pos := ::FirstEditable() diff --git a/src/rtl/tlabel.prg b/src/rtl/tlabel.prg index 382ccb4173..d8bbfbf921 100644 --- a/src/rtl/tlabel.prg +++ b/src/rtl/tlabel.prg @@ -55,9 +55,6 @@ #include "fileio.ch" #include "inkey.ch" -#define F_OK 0 // No error -#define F_EMPTY -3 // File is empty - #define _LF_SAMPLES 2 // "Do you want more samples?" #define _LF_YN 12 // "Y/N" @@ -106,7 +103,7 @@ CREATE CLASS HBLabelForm VAR nCurrentCol AS NUMERIC // The current column in the band METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; - bWhile, nNext, nRecord, lRest, lSample ) + bWhile, nNext, nRecord, lRest, lSample ) METHOD ExecuteLabel() METHOD SampleLabels() @@ -124,7 +121,7 @@ METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; LOCAL err LOCAL OldMargin - ::aBandToPrint := {} // Array( 5 ) + ::aBandToPrint := {} // Array( 5 ) ::nCurrentCol := 1 // Resolve parameters @@ -151,7 +148,7 @@ METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; ENDIF lConsoleOn := Set( _SET_CONSOLE ) - Set( _SET_CONSOLE, ! ( lNoConsole .OR. ! lConsoleOn ) ) + Set( _SET_CONSOLE, ! lNoConsole .AND. lConsoleOn ) IF ! Empty( cAltFile ) // To file lExtraState := Set( _SET_EXTRA, .T. ) @@ -219,22 +216,20 @@ METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; METHOD ExecuteLabel() CLASS HBLabelForm - LOCAL nField, nMoreLines, aBuffer := {}, cBuffer - LOCAL v + LOCAL nField, aField, nMoreLines, aBuffer := {}, cBuffer + LOCAL item // Load the current record into aBuffer - FOR nField := 1 TO Len( ::aLabelData[ LBL_FIELDS ] ) + FOR EACH aField IN ::aLabelData[ LBL_FIELDS ] - IF ::aLabelData[ LBL_FIELDS, nField ] != NIL - - v := Eval( ::aLabelData[ LBL_FIELDS, nField, LF_EXP ] ) + IF aField != NIL cBuffer := ; - PadR( v, ::aLabelData[ LBL_WIDTH ] ) + ; + PadR( Eval( aField[ LF_EXP ] ), ::aLabelData[ LBL_WIDTH ] ) + ; Space( ::aLabelData[ LBL_SPACES ] ) - IF ::aLabelData[ LBL_FIELDS, nField, LF_BLANK ] + IF aField[ LF_BLANK ] IF ! Empty( cBuffer ) AAdd( aBuffer, cBuffer ) ENDIF @@ -257,8 +252,8 @@ METHOD ExecuteLabel() CLASS HBLabelForm IF ::nCurrentCol == ::aLabelData[ LBL_ACROSS ] // trim - FOR nField := 1 TO Len( ::aBandToPrint ) - ::aBandToPrint[ nField ] := RTrim( ::aBandToPrint[ nField ] ) + FOR EACH item IN ::aBandToPrint + item := RTrim( item ) NEXT ::lOneMoreBand := .F. @@ -268,18 +263,14 @@ METHOD ExecuteLabel() CLASS HBLabelForm AEval( ::aBandToPrint, {| BandLine | PrintIt( BandLine ) } ) nMoreLines := ::aLabelData[ LBL_HEIGHT ] - Len( ::aBandToPrint ) - IF nMoreLines > 0 - FOR nField := 1 TO nMoreLines - PrintIt() - NEXT - ENDIF - IF ::aLabelData[ LBL_LINES ] > 0 + FOR nField := 1 TO nMoreLines + PrintIt() + NEXT - // Add the spaces between the label lines - FOR nField := 1 TO ::aLabelData[ LBL_LINES ] - PrintIt() - NEXT - ENDIF + // Add the spaces between the label lines + FOR nField := 1 TO ::aLabelData[ LBL_LINES ] + PrintIt() + NEXT // Clear out the band AFill( ::aBandToPrint, Space( ::aLabelData[ LBL_LMARGIN ] ) ) @@ -308,17 +299,15 @@ METHOD SampleLabels() CLASS HBLabelForm // Print the samples AEval( aBand, {| BandLine | PrintIt( BandLine ) } ) - IF ::aLabelData[ LBL_LINES ] > 0 - // Add the spaces between the label lines - FOR nField := 1 TO ::aLabelData[ LBL_LINES ] - PrintIt() - NEXT - ENDIF + // Add the spaces between the label lines + FOR nField := 1 TO ::aLabelData[ LBL_LINES ] + PrintIt() + NEXT // Prompt for more DispOutAt( Row(), 0, __natMsg( _LF_SAMPLES ) + " (" + __natMsg( _LF_YN ) + ")" ) cKey := hb_keyChar( Inkey( 0 ) ) - DispOutAt( Row(), Col(), cKey ) + DispOut( cKey ) IF Row() == MaxRow() hb_Scroll( 0, 0, MaxRow(), MaxCol(), 1 ) SetPos( MaxRow(), 0 ) @@ -337,15 +326,11 @@ METHOD LoadLabel( cLblFile ) CLASS HBLabelForm LOCAL i // Counters LOCAL cBuff := Space( BUFFSIZE ) // File buffer LOCAL nHandle // File handle - LOCAL nReadCount // Bytes read from file LOCAL nOffset := FILEOFFSET // Offset into file - LOCAL nFileError // File error LOCAL cFieldText // Text expression container LOCAL err // error object - LOCAL cDefPath // contents of SET DEFAULT string - LOCAL aPaths // array of paths - LOCAL nPathIndex // iteration counter + LOCAL cPath // iteration variable // Create and initialize default label array LOCAL aLabel[ LBL_COUNT ] @@ -360,83 +345,55 @@ METHOD LoadLabel( cLblFile ) CLASS HBLabelForm aLabel[ LBL_FIELDS ] := {} // Array of label fields // Open the label file - nHandle := FOpen( cLblFile ) - - IF ! Empty( nFileError := FError() ) .AND. !( "\" $ cLblFile .OR. ":" $ cLblFile ) + IF ( nHandle := FOpen( cLblFile ) ) == F_ERROR .AND. ; + Empty( hb_FNameDir( cLblFile ) ) // Search through default path; attempt to open label file - cDefPath := Set( _SET_DEFAULT ) - cDefPath := StrTran( cDefPath, ",", ";" ) - aPaths := ListAsArray( cDefPath, ";" ) - - FOR nPathIndex := 1 TO Len( aPaths ) - nHandle := FOpen( aPaths[ nPathIndex ] + "\" + cLblFile ) - // if no error is reported, we have our label file - IF Empty( nFileError := FError() ) + FOR EACH cPath IN hb_ATokens( StrTran( Set( _SET_DEFAULT ), ",", ";" ), ";" ) + IF ( nHandle := FOpen( hb_DirSepAdd( cPath ) + cLblFile ) ) != F_ERROR EXIT ENDIF NEXT ENDIF // File error - IF nFileError != F_OK + IF nHandle == F_ERROR err := ErrorNew() err:severity := ES_ERROR err:genCode := EG_OPEN err:subSystem := "FRMLBL" - err:osCode := nFileError + err:osCode := FError() err:filename := cLblFile Eval( ErrorBlock(), err ) - ENDIF - - // If we got this far, assume the label file is open and ready to go - // and so go ahead and read it - nReadCount := FRead( nHandle, @cBuff, BUFFSIZE ) - - // READ ok? - IF nReadCount == 0 - nFileError := F_EMPTY // File is empty ELSE - nFileError := FError() // Check for OS errors - ENDIF + IF FRead( nHandle, @cBuff, BUFFSIZE ) > 0 .AND. FError() == 0 + // Load label dimension into aLabel + aLabel[ LBL_REMARK ] := hb_BSubStr( cBuff, REMARKOFFSET, REMARKSIZE ) + aLabel[ LBL_HEIGHT ] := Bin2W( hb_BSubStr( cBuff, HEIGHTOFFSET, HEIGHTSIZE ) ) + aLabel[ LBL_WIDTH ] := Bin2W( hb_BSubStr( cBuff, WIDTHOFFSET, WIDTHSIZE ) ) + aLabel[ LBL_LMARGIN ] := Bin2W( hb_BSubStr( cBuff, LMARGINOFFSET, LMARGINSIZE ) ) + aLabel[ LBL_LINES ] := Bin2W( hb_BSubStr( cBuff, LINESOFFSET, LINESSIZE ) ) + aLabel[ LBL_SPACES ] := Bin2W( hb_BSubStr( cBuff, SPACESOFFSET, SPACESSIZE ) ) + aLabel[ LBL_ACROSS ] := Bin2W( hb_BSubStr( cBuff, ACROSSOFFSET, ACROSSSIZE ) ) - IF nFileError == 0 + FOR i := 1 TO aLabel[ LBL_HEIGHT ] - // Load label dimension into aLabel - aLabel[ LBL_REMARK ] := hb_BSubStr( cBuff, REMARKOFFSET, REMARKSIZE ) - aLabel[ LBL_HEIGHT ] := Bin2W( hb_BSubStr( cBuff, HEIGHTOFFSET, HEIGHTSIZE ) ) - aLabel[ LBL_WIDTH ] := Bin2W( hb_BSubStr( cBuff, WIDTHOFFSET, WIDTHSIZE ) ) - aLabel[ LBL_LMARGIN ] := Bin2W( hb_BSubStr( cBuff, LMARGINOFFSET, LMARGINSIZE ) ) - aLabel[ LBL_LINES ] := Bin2W( hb_BSubStr( cBuff, LINESOFFSET, LINESSIZE ) ) - aLabel[ LBL_SPACES ] := Bin2W( hb_BSubStr( cBuff, SPACESOFFSET, SPACESSIZE ) ) - aLabel[ LBL_ACROSS ] := Bin2W( hb_BSubStr( cBuff, ACROSSOFFSET, ACROSSSIZE ) ) + // Get the text of the expression + cFieldText := RTrim( hb_BSubStr( cBuff, nOffset, FIELDSIZE ) ) + nOffset += FIELDSIZE - FOR i := 1 TO aLabel[ LBL_HEIGHT ] - - // Get the text of the expression - cFieldText := RTrim( hb_BSubStr( cBuff, nOffset, FIELDSIZE ) ) - nOffset += 60 - - IF ! Empty( cFieldText ) - - AAdd( aLabel[ LBL_FIELDS ], {} ) - - // Field expression - AAdd( aLabel[ LBL_FIELDS, i ], hb_macroBlock( cFieldText ) ) - - // Text of field - AAdd( aLabel[ LBL_FIELDS, i ], cFieldText ) - - // Compression option - AAdd( aLabel[ LBL_FIELDS, i ], .T. ) - ELSE - AAdd( aLabel[ LBL_FIELDS ], NIL ) - ENDIF - NEXT - - // Close file - FClose( nHandle ) + IF Empty( cFieldText ) + AAdd( aLabel[ LBL_FIELDS ], NIL ) + ELSE + AAdd( aLabel[ LBL_FIELDS ], { ; + /* LF_EXP */ hb_macroBlock( cFieldText ), ; + /* LF_TEXT */ cFieldText, ; + /* LF_BLANK */ .T. } ) + ENDIF + NEXT + ENDIF + FClose( nHandle ) // Close file ENDIF RETURN aLabel @@ -449,43 +406,7 @@ FUNCTION __LabelForm( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; STATIC PROCEDURE PrintIt( cString ) - hb_default( @cString, "" ) - - QQOut( cString ) + QQOut( hb_defaultValue( cString, "" ) ) QOut() RETURN - -STATIC FUNCTION ListAsArray( cList, cDelimiter ) - - LOCAL nPos - LOCAL aList := {} // Define an empty array - LOCAL lDelimLast := .F. - - hb_default( @cDelimiter, "," ) - - DO WHILE Len( cList ) != 0 - - nPos := At( cDelimiter, cList ) - - IF nPos == 0 - nPos := Len( cList ) - ENDIF - - IF SubStr( cList, nPos, 1 ) == cDelimiter - lDelimLast := .T. - AAdd( aList, SubStr( cList, 1, nPos - 1 ) ) // Add a new element - ELSE - lDelimLast := .F. - AAdd( aList, SubStr( cList, 1, nPos ) ) // Add a new element - ENDIF - - cList := SubStr( cList, nPos + 1 ) - - ENDDO - - IF lDelimLast - AAdd( aList, "" ) - ENDIF - - RETURN aList // Return the array diff --git a/src/rtl/treport.prg b/src/rtl/treport.prg index dfce5d6e11..cfb30ce3ed 100644 --- a/src/rtl/treport.prg +++ b/src/rtl/treport.prg @@ -198,7 +198,7 @@ METHOD New( cFrmName AS STRING, ; LOCAL lPrintOn, lConsoleOn // Status of PRINTER and CONSOLE LOCAL cExtraFile, lExtraState // Status of EXTRA - LOCAL nCol, nGroup + LOCAL nCol, aCol, nGroup LOCAL xBreakVal, lBroke := .F. LOCAL err @@ -235,7 +235,6 @@ METHOD New( cFrmName AS STRING, ; cExtraFile := Set( _SET_EXTRAFILE, cAltFile ) ENDIF - BEGIN SEQUENCE ::aReportData := ::LoadReportFile( cFRMName ) // Load the frm into an array @@ -285,9 +284,9 @@ METHOD New( cFrmName AS STRING, ; // Column total elements FOR nCol := 1 TO Len( ::aReportData[ RPT_COLUMNS ] ) - IF ::aReportData[ RPT_COLUMNS, nCol, RCT_TOTAL ] + IF ::aReportData[ RPT_COLUMNS ][ nCol ][ RCT_TOTAL ] FOR nGroup := 1 TO Len( ::aReportTotals ) - ::aReportTotals[ nGroup, nCol ] := 0 + ::aReportTotals[ nGroup ][ nCol ] := 0 NEXT ENDIF NEXT @@ -302,11 +301,10 @@ METHOD New( cFrmName AS STRING, ; // Make a pass through all the groups FOR nGroup := Len( ::aReportData[ RPT_GROUPS ] ) TO 1 STEP -1 - // make sure group has subtotals lAnySubTotals := .F. - FOR nCol := 1 TO Len( ::aReportData[ RPT_COLUMNS ] ) - IF ::aReportData[ RPT_COLUMNS, nCol, RCT_TOTAL ] + FOR EACH aCol IN ::aReportData[ RPT_COLUMNS ] + IF aCol[ RCT_TOTAL ] lAnySubTotals := .T. EXIT // NOTE ENDIF @@ -316,7 +314,6 @@ METHOD New( cFrmName AS STRING, ; LOOP // NOTE ENDIF - // Check to see if we need to eject the page IF ::nLinesLeft < 2 ::EjectPage() @@ -337,29 +334,27 @@ METHOD New( cFrmName AS STRING, ; IF nCol > 1 QQOut( " " ) ENDIF - IF ::aReportData[ RPT_COLUMNS, nCol, RCT_TOTAL ] - QQOut( Transform( ::aReportTotals[ nGroup + 1, nCol ], ; - ::aReportData[ RPT_COLUMNS, nCol, RCT_PICT ] ) ) + IF ::aReportData[ RPT_COLUMNS ][ nCol ][ RCT_TOTAL ] + QQOut( Transform( ::aReportTotals[ nGroup + 1 ][ nCol ], ; + ::aReportData[ RPT_COLUMNS ][ nCol ][ RCT_PICT ] ) ) ELSE - QQOut( Space( ::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ] ) ) + QQOut( Space( ::aReportData[ RPT_COLUMNS ][ nCol ][ RCT_WIDTH ] ) ) ENDIF NEXT - // Send a cr/lf for the last line + // Send an EOL for the last line QOut() - NEXT // Any report totals? lAnyTotals := .F. - FOR nCol := 1 TO Len( ::aReportData[ RPT_COLUMNS ] ) - IF ::aReportData[ RPT_COLUMNS, nCol, RCT_TOTAL ] + FOR EACH aCol IN ::aReportData[ RPT_COLUMNS ] + IF aCol[ RCT_TOTAL ] lAnyTotals := .T. EXIT ENDIF NEXT - IF lAnyTotals // Check to see if we need to eject the page @@ -381,17 +376,16 @@ METHOD New( cFrmName AS STRING, ; IF nCol > 1 QQOut( " " ) ENDIF - IF ::aReportData[ RPT_COLUMNS, nCol, RCT_TOTAL ] - QQOut( Transform( ::aReportTotals[ 1, nCol ], ; - ::aReportData[ RPT_COLUMNS, nCol, RCT_PICT ] ) ) + IF ::aReportData[ RPT_COLUMNS ][ nCol ][ RCT_TOTAL ] + QQOut( Transform( ::aReportTotals[ 1 ][ nCol ], ; + ::aReportData[ RPT_COLUMNS ][ nCol ][ RCT_PICT ] ) ) ELSE - QQOut( Space( ::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ] ) ) + QQOut( Space( ::aReportData[ RPT_COLUMNS ][ nCol ][ RCT_WIDTH ] ) ) ENDIF NEXT - // Send a cr/lf for the last line + // Send an EOL for the last line QOut() - ENDIF // Check to see if an "after report" eject, or TO FILE has been specified @@ -399,14 +393,12 @@ METHOD New( cFrmName AS STRING, ; ::EjectPage() ENDIF - RECOVER USING xBreakVal lBroke := .T. END SEQUENCE - // Clean up and leave ::aReportData := NIL // Recover the space ::aReportTotals := NIL @@ -435,9 +427,7 @@ METHOD New( cFrmName AS STRING, ; METHOD PrintIt( cString AS STRING ) CLASS HBReportForm - hb_default( @cString, "" ) - - QQOut( cString ) + QQOut( hb_defaultValue( cString, "" ) ) QOut() RETURN Self @@ -455,7 +445,7 @@ METHOD ReportHeader() CLASS HBReportForm LOCAL nLinesInHeader LOCAL aPageHeader := {} LOCAL nHeadingLength := ::aReportData[ RPT_WIDTH ] - ::aReportData[ RPT_LMARGIN ] - 30 - LOCAL nCol, nLine, nMaxColLength, cHeader + LOCAL aCol, nLine, cLine, nMaxColLength, cHeader LOCAL nHeadline LOCAL nRPageSize LOCAL aTempPgHeader @@ -469,15 +459,13 @@ METHOD ReportHeader() CLASS HBReportForm aTempPgHeader := ParseHeader( ::aReportData[ RPT_HEADING ], ; Occurs( ";", ::aReportData[ RPT_HEADING ] ) + 1 ) - FOR nLine := 1 TO Len( aTempPgHeader ) - nLinesInHeader := Max( XMLCOUNT( LTrim( aTempPgHeader[ nLine ] ), ; - nHeadingLength ), 1 ) + FOR EACH cLine IN aTempPgHeader + nLinesInHeader := Max( XMLCOUNT( LTrim( cLine ), nHeadingLength ), 1 ) FOR nHeadLine := 1 TO nLinesInHeader AAdd( aPageHeader, Space( 15 ) + ; - PadC( RTrim( XMEMOLINE( LTrim( aTempPgHeader[ nLine ] ), ; + PadC( RTrim( XMEMOLINE( LTrim( cLine ), ; nHeadingLength, nHeadLine ) ), nHeadingLength ) ) - NEXT NEXT @@ -488,53 +476,45 @@ METHOD ReportHeader() CLASS HBReportForm AAdd( aPageHeader, DToC( Date() ) ) ENDIF - FOR nLine := 1 TO Len( ::aReportData[ RPT_HEADER ] ) + FOR EACH cLine IN ::aReportData[ RPT_HEADER ] - nLinesInHeader := Max( XMLCOUNT( LTrim( ::aReportData[ RPT_HEADER, ; - nLine ] ) ), 1 ) + nLinesInHeader := Max( XMLCOUNT( LTrim( cLine ) ), 1 ) FOR nHeadLine := 1 TO nLinesInHeader - cHeader := RTrim( XMEMOLINE( LTrim( ::aReportData[ RPT_HEADER, nLine ] ),, ; - nHeadLine ) ) + cHeader := RTrim( XMEMOLINE( LTrim( cLine ),, nHeadLine ) ) AAdd( aPageHeader, Space( ( nRPageSize - ::aReportData[ RPT_LMARGIN ] - ; Len( cHeader ) ) / 2 ) + cHeader ) NEXT NEXT - AAdd( aPageHeader, "" ) // S87 compat. + AAdd( aPageHeader, "" ) // S87 compat. nLinesInHeader := Len( aPageHeader ) nMaxColLength := 0 - FOR nCol := 1 TO Len( ::aReportData[ RPT_COLUMNS ] ) - nMaxColLength := Max( Len( ::aReportData[ RPT_COLUMNS, nCol, RCT_HEADER ] ), ; - nMaxColLength ) + FOR EACH aCol IN ::aReportData[ RPT_COLUMNS ] + nMaxColLength := Max( Len( aCol[ RCT_HEADER ] ), nMaxColLength ) NEXT - FOR nCol := 1 TO Len( ::aReportData[ RPT_COLUMNS ] ) - ASize( ::aReportData[ RPT_COLUMNS, nCol, RCT_HEADER ], nMaxColLength ) + FOR EACH aCol IN ::aReportData[ RPT_COLUMNS ] + ASize( aCol[ RCT_HEADER ], nMaxColLength ) NEXT FOR nLine := 1 TO nMaxColLength AAdd( aPageHeader, "" ) NEXT - FOR nCol := 1 TO Len( ::aReportData[ RPT_COLUMNS ] ) // Cycle through the columns + FOR EACH aCol IN ::aReportData[ RPT_COLUMNS ] // Cycle through the columns FOR nLine := 1 TO nMaxColLength - IF nCol > 1 + IF ! aCol:__enumIsFirst() aPageHeader[ nLinesInHeader + nLine ] += " " ENDIF - IF ::aReportData[ RPT_COLUMNS, nCol, RCT_HEADER, nLine ] == NIL + IF aCol[ RCT_HEADER ][ nLine ] == NIL + aPageHeader[ nLinesInHeader + nLine ] += Space( aCol[ RCT_WIDTH ] ) + ELSEIF aCol[ RCT_TYPE ] == "N" aPageHeader[ nLinesInHeader + nLine ] += ; - Space( ::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ] ) + PadL( aCol[ RCT_HEADER ][ nLine ], aCol[ RCT_WIDTH ] ) ELSE - IF ::aReportData[ RPT_COLUMNS, nCol, RCT_TYPE ] == "N" - aPageHeader[ nLinesInHeader + nLine ] += ; - PadL( ::aReportData[ RPT_COLUMNS, nCol, RCT_HEADER, nLine ], ; - ::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ] ) - ELSE - aPageHeader[ nLinesInHeader + nLine ] += ; - PadR( ::aReportData[ RPT_COLUMNS, nCol, RCT_HEADER, nLine ], ; - ::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ] ) - ENDIF + aPageHeader[ nLinesInHeader + nLine ] += ; + PadR( aCol[ RCT_HEADER ][ nLine ], aCol[ RCT_WIDTH ] ) ENDIF NEXT NEXT @@ -552,13 +532,14 @@ METHOD ReportHeader() CLASS HBReportForm ::nLinesLeft := ::aReportData[ RPT_LINES ] - Len( aPageHeader ) ::nMaxLinesAvail := ::aReportData[ RPT_LINES ] - Len( aPageHeader ) - RETURN SELF + RETURN Self METHOD ExecuteReport() CLASS HBReportForm LOCAL aRecordHeader := {} // Header for the current record LOCAL aRecordToPrint := {} // Current record to print LOCAL nCol // Counter for the column work + LOCAL aCol LOCAL nGroup // Counter for the group work LOCAL lGroupChanged := .F. // Has any group changed? LOCAL lEjectGrp := .F. // Group eject indicator @@ -571,10 +552,10 @@ METHOD ExecuteReport() CLASS HBReportForm // Add to the main column totals FOR nCol := 1 TO Len( ::aReportData[ RPT_COLUMNS ] ) - IF ::aReportData[ RPT_COLUMNS, nCol, RCT_TOTAL ] + IF ::aReportData[ RPT_COLUMNS ][ nCol ][ RCT_TOTAL ] // If this column should be totaled, do it - ::aReportTotals[ 1, nCol ] += ; - Eval( ::aReportData[ RPT_COLUMNS, nCol, RCT_EXP ] ) + ::aReportTotals[ 1 ][ nCol ] += ; + Eval( ::aReportData[ RPT_COLUMNS ][ nCol ][ RCT_EXP ] ) ENDIF NEXT @@ -587,8 +568,8 @@ METHOD ExecuteReport() CLASS HBReportForm // make sure group has subtotals lAnySubTotals := .F. - FOR nCol := 1 TO Len( ::aReportData[ RPT_COLUMNS ] ) - IF ::aReportData[ RPT_COLUMNS, nCol, RCT_TOTAL ] + FOR EACH aCol IN ::aReportData[ RPT_COLUMNS ] + IF aCol[ RCT_TOTAL ] lAnySubTotals := .T. EXIT // NOTE ENDIF @@ -596,7 +577,7 @@ METHOD ExecuteReport() CLASS HBReportForm // retrieve group eject state from report form IF nGroup == 1 - lEjectGrp := ::aReportData[ RPT_GROUPS, nGroup, RGT_AEJECT ] + lEjectGrp := ::aReportData[ RPT_GROUPS ][ nGroup ][ RGT_AEJECT ] ENDIF IF ! lAnySubTotals @@ -604,39 +585,36 @@ METHOD ExecuteReport() CLASS HBReportForm ENDIF // For subgroup processing: check if group has been changed - IF MakeAStr( Eval( ::aReportData[ RPT_GROUPS, 1, RGT_EXP ] ), ; - ::aReportData[ RPT_GROUPS, 1, RGT_TYPE ] ) != ::aGroupTotals[ 1 ] + IF MakeAStr( Eval( ::aReportData[ RPT_GROUPS ][ 1 ][ RGT_EXP ] ), ; + ::aReportData[ RPT_GROUPS ][ 1 ][ RGT_TYPE ] ) != ::aGroupTotals[ 1 ] lGroupChanged := .T. ENDIF // If this (sub)group has changed since the last record - IF lGroupChanged .OR. MakeAStr( Eval( ::aReportData[ RPT_GROUPS, nGroup, RGT_EXP ] ), ; - ::aReportData[ RPT_GROUPS, nGroup, RGT_TYPE ] ) != ::aGroupTotals[ nGroup ] + IF lGroupChanged .OR. MakeAStr( Eval( ::aReportData[ RPT_GROUPS ][ nGroup ][ RGT_EXP ] ), ; + ::aReportData[ RPT_GROUPS ][ nGroup ][ RGT_TYPE ] ) != ::aGroupTotals[ nGroup ] AAdd( aRecordHeader, __natMsg( iif( nGroup == 1, _RFRM_SUBTOTAL, _RFRM_SUBSUBTOTAL ) ) ) AAdd( aRecordHeader, "" ) - // Cycle through the columns, adding either the group // amount from ::aReportTotals or spaces wide enough for // the non-totaled columns FOR nCol := 1 TO Len( ::aReportData[ RPT_COLUMNS ] ) - IF ::aReportData[ RPT_COLUMNS, nCol, RCT_TOTAL ] + IF ::aReportData[ RPT_COLUMNS ][ nCol ][ RCT_TOTAL ] aRecordHeader[ Len( aRecordHeader ) ] += ; - Transform( ::aReportTotals[ nGroup + 1, nCol ], ; - ::aReportData[ RPT_COLUMNS, nCol, RCT_PICT ] ) + Transform( ::aReportTotals[ nGroup + 1 ][ nCol ], ; + ::aReportData[ RPT_COLUMNS ][ nCol ][ RCT_PICT ] ) // Zero out the group totals column from aReportTotals - ::aReportTotals[ nGroup + 1, nCol ] := 0 + ::aReportTotals[ nGroup + 1 ][ nCol ] := 0 ELSE aRecordHeader[ Len( aRecordHeader ) ] += ; - Space( ::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ] ) + Space( ::aReportData[ RPT_COLUMNS ][ nCol ][ RCT_WIDTH ] ) ENDIF aRecordHeader[ Len( aRecordHeader ) ] += " " NEXT // Get rid of the extra space from the last column - aRecordHeader[ Len( aRecordHeader ) ] := ; - Left( aRecordHeader[ Len( aRecordHeader ) ], ; - Len( aRecordHeader[ Len( aRecordHeader ) ] ) - 1 ) + aRecordHeader[ Len( aRecordHeader ) ] := hb_StrShrink( ATail( aRecordHeader ) ) ENDIF NEXT ENDIF @@ -650,7 +628,6 @@ METHOD ExecuteReport() CLASS HBReportForm ELSE ::ReportHeader() ENDIF - ENDIF AEval( aRecordHeader, {| HeaderLine | ; @@ -673,25 +650,24 @@ METHOD ExecuteReport() CLASS HBReportForm // Cycle through the groups FOR nGroup := 1 TO Len( ::aReportData[ RPT_GROUPS ] ) // If the group has changed - IF MakeAStr( Eval( ::aReportData[ RPT_GROUPS, nGroup, RGT_EXP ] ), ; - ::aReportData[ RPT_GROUPS, nGroup, RGT_TYPE ] ) == ::aGroupTotals[ nGroup ] - ELSE + IF !( MakeAStr( Eval( ::aReportData[ RPT_GROUPS ][ nGroup ][ RGT_EXP ] ), ; + ::aReportData[ RPT_GROUPS ][ nGroup ][ RGT_TYPE ] ) == ::aGroupTotals[ nGroup ] ) + AAdd( aRecordHeader, "" ) // The blank line // page eject after group - // put CRFF after group + // put CRFF after group IF nGroup == 1 .AND. ! ::lFirstPass .AND. ! lAnySubTotals - IF ::aReportData[ RPT_GROUPS, nGroup, RGT_AEJECT ] - ::nLinesLeft := 0 + IF ::aReportData[ RPT_GROUPS ][ nGroup ][ RGT_AEJECT ] + ::nLinesLeft := 0 ENDIF ENDIF - AAdd( aRecordHeader, iif( nGroup == 1, "** ", "* " ) + ; - ::aReportData[ RPT_GROUPS, nGroup, RGT_HEADER ] + " " + ; - MakeAStr( Eval( ::aReportData[ RPT_GROUPS, nGroup, RGT_EXP ] ), ; - ::aReportData[ RPT_GROUPS, nGroup, RGT_TYPE ] ) ) + ::aReportData[ RPT_GROUPS ][ nGroup ][ RGT_HEADER ] + " " + ; + MakeAStr( Eval( ::aReportData[ RPT_GROUPS ][ nGroup ][ RGT_EXP ] ), ; + ::aReportData[ RPT_GROUPS ][ nGroup ][ RGT_TYPE ] ) ) ENDIF NEXT @@ -730,34 +706,30 @@ METHOD ExecuteReport() CLASS HBReportForm // Add to the group totals FOR nCol := 1 TO Len( ::aReportData[ RPT_COLUMNS ] ) // If this column should be totaled, do it - IF ::aReportData[ RPT_COLUMNS, nCol, RCT_TOTAL ] + IF ::aReportData[ RPT_COLUMNS ][ nCol ][ RCT_TOTAL ] // Cycle through the groups FOR nGroup := 1 TO Len( ::aReportTotals ) - 1 - ::aReportTotals[ nGroup + 1, nCol ] += ; - Eval( ::aReportData[ RPT_COLUMNS, nCol, RCT_EXP ] ) + ::aReportTotals[ nGroup + 1 ][ nCol ] += ; + Eval( ::aReportData[ RPT_COLUMNS ][ nCol ][ RCT_EXP ] ) NEXT ENDIF NEXT // Reset the group expressions in aGroupTotals FOR nGroup := 1 TO Len( ::aReportData[ RPT_GROUPS ] ) - ::aGroupTotals[ nGroup ] := MakeAStr( Eval( ::aReportData[ RPT_GROUPS, nGroup, RGT_EXP ] ), ; - ::aReportData[ RPT_GROUPS, nGroup, RGT_TYPE ] ) + ::aGroupTotals[ nGroup ] := MakeAStr( Eval( ::aReportData[ RPT_GROUPS ][ nGroup ][ RGT_EXP ] ), ; + ::aReportData[ RPT_GROUPS ][ nGroup ][ RGT_TYPE ] ) NEXT // Only run through the record detail if this is NOT a summary report IF ! ::aReportData[ RPT_SUMMARY ] // Determine the max number of lines needed by each expression nMaxLines := 1 - FOR nCol := 1 TO Len( ::aReportData[ RPT_COLUMNS ] ) - - IF ::aReportData[ RPT_COLUMNS, nCol, RCT_TYPE ] $ "M" - nMaxLines := Max( XMLCOUNT( Eval( ::aReportData[ RPT_COLUMNS, nCol, RCT_EXP ] ), ; - ::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ] ), nMaxLines ) - ELSEIF ::aReportData[ RPT_COLUMNS, nCol, RCT_TYPE ] $ "C" - nMaxLines := Max( XMLCOUNT( StrTran( Eval( ::aReportData[ RPT_COLUMNS, nCol, RCT_EXP ] ), ; - ";", hb_eol() ), ; - ::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ] ), nMaxLines ) + FOR EACH aCol IN ::aReportData[ RPT_COLUMNS ] + IF aCol[ RCT_TYPE ] $ "M" + nMaxLines := Max( XMLCOUNT( Eval( aCol[ RCT_EXP ] ), aCol[ RCT_WIDTH ] ), nMaxLines ) + ELSEIF aCol[ RCT_TYPE ] $ "C" + nMaxLines := Max( XMLCOUNT( StrTran( Eval( aCol[ RCT_EXP ] ), ";", hb_eol() ), aCol[ RCT_WIDTH ] ), nMaxLines ) ENDIF NEXT @@ -767,32 +739,32 @@ METHOD ExecuteReport() CLASS HBReportForm AFill( aRecordToPrint, "" ) // Load the current record into aRecordToPrint - FOR nCol := 1 TO Len( ::aReportData[ RPT_COLUMNS ] ) + FOR EACH aCol IN ::aReportData[ RPT_COLUMNS ] FOR nLine := 1 TO nMaxLines // Check to see if it's a memo or character - IF ::aReportData[ RPT_COLUMNS, nCol, RCT_TYPE ] $ "CM" + IF aCol[ RCT_TYPE ] $ "CM" // Load the current line of the current column into cLine // with multi-lines per record ";"- method - IF ::aReportData[ RPT_COLUMNS, nCol, RCT_TYPE ] $ "C" - cLine := XMEMOLINE( RTrim( StrTran( Eval( ::aReportData[ RPT_COLUMNS, nCol, RCT_EXP ] ), ; + IF aCol[ RCT_TYPE ] $ "C" + cLine := XMEMOLINE( RTrim( StrTran( Eval( aCol[ RCT_EXP ] ), ; ";", hb_eol() ) ), ; - ::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ], nLine ) + aCol[ RCT_WIDTH ], nLine ) ELSE - cLine := XMEMOLINE( RTrim( Eval( ::aReportData[ RPT_COLUMNS, nCol, RCT_EXP ] ) ), ; - ::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ], nLine ) + cLine := XMEMOLINE( RTrim( Eval( aCol[ RCT_EXP ] ) ), ; + aCol[ RCT_WIDTH ], nLine ) ENDIF - cLine := PadR( cLine, ::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ] ) + cLine := PadR( cLine, aCol[ RCT_WIDTH ] ) ELSE IF nLine == 1 - cLine := Transform( Eval( ::aReportData[ RPT_COLUMNS, nCol, RCT_EXP ] ), ; - ::aReportData[ RPT_COLUMNS, nCol, RCT_PICT ] ) - cLine := PadR( cLine, ::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ] ) + cLine := Transform( Eval( aCol[ RCT_EXP ] ), ; + aCol[ RCT_PICT ] ) + cLine := PadR( cLine, aCol[ RCT_WIDTH ] ) ELSE - cLine := Space( ::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ] ) + cLine := Space( aCol[ RCT_WIDTH ] ) ENDIF ENDIF // Add it to the existing report line - IF nCol > 1 + IF ! aCol:__enumIsFirst() aRecordToPrint[ nLine ] += " " ENDIF aRecordToPrint[ nLine ] += cLine @@ -837,7 +809,6 @@ METHOD ExecuteReport() CLASS HBReportForm ::nLinesLeft -= Len( aRecordToPrint ) ENDIF - // Tack on the spacing for double/triple/etc. IF ::aReportData[ RPT_SPACING ] > 1 @@ -850,7 +821,6 @@ METHOD ExecuteReport() CLASS HBReportForm NEXT ENDIF ENDIF - ENDIF // Was this a summary report? RETURN NIL @@ -859,24 +829,19 @@ METHOD LoadReportFile( cFrmFile AS STRING ) CLASS HBReportForm LOCAL cFieldsBuff LOCAL cParamsBuff - LOCAL nFieldOffset := 0 - LOCAL cFileBuff := Space( SIZE_FILE_BUFF ) + LOCAL nFieldOffset + LOCAL cFileBuff := Space( SIZE_FILE_BUFF ) LOCAL cGroupExp LOCAL cSubGroupExp LOCAL nColCount // Number of columns in report LOCAL nCount LOCAL nFrmHandle // (.frm) file handle - LOCAL nBytesRead // Read/write and content record counter - LOCAL nPointer // Points to an offset into EXPR_BUFF string - LOCAL nFileError // Contains current file error - LOCAL cOptionByte // Contains option byte + LOCAL nOptionByte // Contains option byte LOCAL aReport[ RPT_COUNT ] // Create report array LOCAL err // error object - LOCAL cDefPath // contents of SET DEFAULT string - LOCAL aPaths // array of paths - LOCAL nPathIndex // iteration counter + LOCAL cPath // iteration variable LOCAL aHeader // temporary storage for report form headings LOCAL nHeaderIndex // index into temporary header array @@ -903,209 +868,151 @@ METHOD LoadReportFile( cFrmFile AS STRING ) CLASS HBReportForm aReport[ RPT_HEADING ] := "" // Open the report file - nFrmHandle := FOpen( cFrmFile ) - - IF ! Empty( nFileError := FError() ) .AND. !( "\" $ cFrmFile .OR. ":" $ cFrmFile ) + IF ( nFrmHandle := FOpen( cFrmFile ) ) == F_ERROR .AND. ; + Empty( hb_FNameDir( cFrmFile ) ) // Search through default path; attempt to open report file - cDefPath := Set( _SET_DEFAULT ) + ";" + Set( _SET_PATH ) - cDefPath := StrTran( cDefPath, ",", ";" ) - aPaths := ListAsArray( cDefPath, ";" ) - - FOR nPathIndex := 1 TO Len( aPaths ) - nFrmHandle := FOpen( aPaths[ nPathIndex ] + "\" + cFrmFile ) - // if no error is reported, we have our report file - IF Empty( nFileError := FError() ) + FOR EACH cPath IN hb_ATokens( StrTran( Set( _SET_DEFAULT ), ",", ";" ), ";" ) + IF ( nFrmHandle := FOpen( hb_DirSepAdd( cPath ) + cFrmFile ) ) != F_ERROR EXIT ENDIF NEXT ENDIF // File error - IF nFileError != F_OK + IF nFrmHandle == F_ERROR err := ErrorNew() err:severity := ES_ERROR err:genCode := EG_OPEN err:subSystem := "FRMLBL" - err:osCode := nFileError + err:osCode := FError() err:filename := cFrmFile Eval( ErrorBlock(), err ) - ENDIF + ELSE + IF FRead( nFrmHandle, @cFileBuff, SIZE_FILE_BUFF ) > 0 .AND. FError() == 0 + // Is this a .frm type file (2 at start and end of file) + IF Bin2W( hb_BSubStr( cFileBuff, 1, 2 ) ) == 2 .AND. ; + Bin2W( hb_BSubStr( cFileBuff, SIZE_FILE_BUFF - 1, 2 ) ) == 2 - // OPEN ok? - IF nFileError == F_OK + // Fill processing buffers + ::cLengthsBuff := hb_BSubStr( cFileBuff, LENGTHS_OFFSET, SIZE_LENGTHS_BUFF ) + ::cOffSetsBuff := hb_BSubStr( cFileBuff, OFFSETS_OFFSET, SIZE_OFFSETS_BUFF ) + ::cExprBuff := hb_BSubStr( cFileBuff, EXPR_OFFSET, SIZE_EXPR_BUFF ) + cFieldsBuff := hb_BSubStr( cFileBuff, FIELDS_OFFSET, SIZE_FIELDS_BUFF ) + cParamsBuff := hb_BSubStr( cFileBuff, PARAMS_OFFSET, SIZE_PARAMS_BUFF ) - // Go to START of report file - FSeek( nFrmHandle, 0 ) + // Process report attributes + // Report width + aReport[ RPT_WIDTH ] := Bin2W( hb_BSubStr( cParamsBuff, PAGE_WIDTH_OFFSET, 2 ) ) - // SEEK ok? - nFileError := FError() - IF nFileError == F_OK + // Lines per page + aReport[ RPT_LINES ] := Bin2W( hb_BSubStr( cParamsBuff, LNS_PER_PAGE_OFFSET, 2 ) ) - // Read entire file into process buffer - nBytesRead := FRead( nFrmHandle, @cFileBuff, SIZE_FILE_BUFF ) + // Page offset (left margin) + aReport[ RPT_LMARGIN ] := Bin2W( hb_BSubStr( cParamsBuff, LEFT_MRGN_OFFSET, 2 ) ) - // READ ok? - IF nBytesRead == 0 - nFileError := F_EMPTY // file is empty - ELSE - nFileError := FError() // check for OS errors - ENDIF + // Page right margin (not used) + aReport[ RPT_RMARGIN ] := Bin2W( hb_BSubStr( cParamsBuff, RIGHT_MGRN_OFFSET, 2 ) ) - IF nFileError == F_OK + nColCount := Bin2W( hb_BSubStr( cParamsBuff, COL_COUNT_OFFSET, 2 ) ) - // Is this a .frm type file (2 at start and end of file) - IF Bin2W( hb_BSubStr( cFileBuff, 1, 2 ) ) == 2 .AND. ; - Bin2W( hb_BSubStr( cFileBuff, SIZE_FILE_BUFF - 1, 2 ) ) == 2 + // Line spacing + // Spacing is 1, 2, or 3 + aReport[ RPT_SPACING ] := iif( hb_BSubStr( cParamsBuff, ; + DBL_SPACE_OFFSET, 1 ) $ "YyTt", 2, 1 ) - nFileError := F_OK - ELSE - nFileError := F_ERROR + // Summary report flag + aReport[ RPT_SUMMARY ] := hb_BSubStr( cParamsBuff, SUMMARY_RPT_OFFSET, 1 ) $ "YyTt" + + // Process report eject and plain attributes option byte + nOptionByte := hb_BPeek( cParamsBuff, OPTION_OFFSET ) + +#ifdef HB_CLP_STRICT + IF nOptionByte <= 8 /* Bug compatibility with CA-Cl*pper for corrupted input files */ +#endif + IF hb_bitAnd( nOptionByte, 4 ) != 0 + aReport[ RPT_PLAIN ] := .T. // Plain page + ENDIF + IF hb_bitAnd( nOptionByte, 2 ) != 0 + aReport[ RPT_AEJECT ] := .T. // Page eject after report + ENDIF + IF hb_bitAnd( nOptionByte, 1 ) != 0 + aReport[ RPT_BEJECT ] := .F. // Page eject before report + ENDIF +#ifdef HB_CLP_STRICT + ENDIF +#endif + + // Page heading, report title + // Retrieve the header stored in the .frm file + nHeaderIndex := 4 + aHeader := ParseHeader( ::GetExpr( Bin2W( hb_BSubStr( cParamsBuff, PAGE_HDR_OFFSET, 2 ) ) ), nHeaderIndex ) + + // certain that we have retrieved all heading entries from the .frm file, we + // now retract the empty headings + DO WHILE nHeaderIndex > 0 + IF ! Empty( aHeader[ nHeaderIndex ] ) + EXIT + ENDIF + nHeaderIndex-- + ENDDO + + aReport[ RPT_HEADER ] := iif( nHeaderIndex == 0, {}, ASize( aHeader, nHeaderIndex ) ) + + // Process Groups + // Group + IF ! Empty( cGroupExp := ::GetExpr( Bin2W( hb_BSubStr( cParamsBuff, GRP_EXPR_OFFSET, 2 ) ) ) ) + + // Add a new group array + AAdd( aReport[ RPT_GROUPS ], Array( RGT_COUNT ) ) + + // Group expression + aReport[ RPT_GROUPS ][ 1 ][ RGT_TEXT ] := cGroupExp + aReport[ RPT_GROUPS ][ 1 ][ RGT_EXP ] := hb_macroBlock( cGroupExp ) + IF Used() + aReport[ RPT_GROUPS ][ 1 ][ RGT_TYPE ] := ; + ValType( Eval( aReport[ RPT_GROUPS ][ 1 ][ RGT_EXP ] ) ) + ENDIF + + // Group header + aReport[ RPT_GROUPS ][ 1 ][ RGT_HEADER ] := ; + ::GetExpr( Bin2W( hb_BSubStr( cParamsBuff, GRP_HDR_OFFSET, 2 ) ) ) + + // Page eject after group + aReport[ RPT_GROUPS ][ 1 ][ RGT_AEJECT ] := hb_BSubStr( cParamsBuff, ; + PE_OFFSET, 1 ) $ "YyTt" ENDIF + // Subgroup + IF ! Empty( cSubGroupExp := ::GetExpr( Bin2W( hb_BSubStr( cParamsBuff, SUB_EXPR_OFFSET, 2 ) ) ) ) + + // Add new group array + AAdd( aReport[ RPT_GROUPS ], Array( RGT_COUNT ) ) + + // Subgroup expression + aReport[ RPT_GROUPS ][ 2 ][ RGT_TEXT ] := cSubGroupExp + aReport[ RPT_GROUPS ][ 2 ][ RGT_EXP ] := hb_macroBlock( cSubGroupExp ) + IF Used() + aReport[ RPT_GROUPS ][ 2 ][ RGT_TYPE ] := ; + ValType( Eval( aReport[ RPT_GROUPS ][ 2 ][ RGT_EXP ] ) ) + ENDIF + + // Subgroup header + aReport[ RPT_GROUPS ][ 2 ][ RGT_HEADER ] := ; + ::GetExpr( Bin2W( hb_BSubStr( cParamsBuff, SUB_HDR_OFFSET, 2 ) ) ) + + // Page eject after subgroup + aReport[ RPT_GROUPS ][ 2 ][ RGT_AEJECT ] := .F. + ENDIF + + // Process columns + nFieldOffset := 12 // dBASE skips first 12 byte fields block. + FOR nCount := 1 TO nColCount + AAdd( aReport[ RPT_COLUMNS ], ::GetColumn( cFieldsBuff, @nFieldOffset ) ) + NEXT ENDIF - ENDIF - - // Close file - IF ! FClose( nFrmHandle ) - nFileError := FError() - ENDIF - - ENDIF - - // File existed, was opened and read ok and is a .frm file - IF nFileError == F_OK - - // Fill processing buffers - ::cLengthsBuff := hb_BSubStr( cFileBuff, LENGTHS_OFFSET, SIZE_LENGTHS_BUFF ) - ::cOffSetsBuff := hb_BSubStr( cFileBuff, OFFSETS_OFFSET, SIZE_OFFSETS_BUFF ) - ::cExprBuff := hb_BSubStr( cFileBuff, EXPR_OFFSET, SIZE_EXPR_BUFF ) - cFieldsBuff := hb_BSubStr( cFileBuff, FIELDS_OFFSET, SIZE_FIELDS_BUFF ) - cParamsBuff := hb_BSubStr( cFileBuff, PARAMS_OFFSET, SIZE_PARAMS_BUFF ) - - - // Process report attributes - // Report width - aReport[ RPT_WIDTH ] := Bin2W( hb_BSubStr( cParamsBuff, PAGE_WIDTH_OFFSET, 2 ) ) - - // Lines per page - aReport[ RPT_LINES ] := Bin2W( hb_BSubStr( cParamsBuff, LNS_PER_PAGE_OFFSET, 2 ) ) - - // Page offset (left margin) - aReport[ RPT_LMARGIN ] := Bin2W( hb_BSubStr( cParamsBuff, LEFT_MRGN_OFFSET, 2 ) ) - - // Page right margin (not used) - aReport[ RPT_RMARGIN ] := Bin2W( hb_BSubStr( cParamsBuff, RIGHT_MGRN_OFFSET, 2 ) ) - - nColCount := Bin2W( hb_BSubStr( cParamsBuff, COL_COUNT_OFFSET, 2 ) ) - - // Line spacing - // Spacing is 1, 2, or 3 - aReport[ RPT_SPACING ] := iif( hb_BSubStr( cParamsBuff, ; - DBL_SPACE_OFFSET, 1 ) $ "YyTt", 2, 1 ) - - // Summary report flag - aReport[ RPT_SUMMARY ] := iif( hb_BSubStr( cParamsBuff, ; - SUMMARY_RPT_OFFSET, 1 ) $ "YyTt", .T., .F. ) - - // Process report eject and plain attributes option byte - cOptionByte := Asc( hb_BSubStr( cParamsBuff, OPTION_OFFSET, 1 ) ) - - IF Int( cOptionByte / 4 ) == 1 - aReport[ RPT_PLAIN ] := .T. // Plain page - cOptionByte -= 4 - ENDIF - - IF Int( cOptionByte / 2 ) == 1 - aReport[ RPT_AEJECT ] := .T. // Page eject after report - cOptionByte -= 2 - ENDIF - - IF Int( cOptionByte / 1 ) == 1 - aReport[ RPT_BEJECT ] := .F. // Page eject before report - // cOptionByte -= 1 - ENDIF - - // Page heading, report title - nPointer := Bin2W( hb_BSubStr( cParamsBuff, PAGE_HDR_OFFSET, 2 ) ) - - // Retrieve the header stored in the .frm file - nHeaderIndex := 4 - aHeader := ParseHeader( ::GetExpr( nPointer ), nHeaderIndex ) - - // certain that we have retrieved all heading entries from the .frm file, we - // now retract the empty headings - DO WHILE nHeaderIndex > 0 - IF ! Empty( aHeader[ nHeaderIndex ] ) - EXIT - ENDIF - nHeaderIndex-- - ENDDO - - aReport[ RPT_HEADER ] := iif( Empty( nHeaderIndex ), {}, ; - ASize( aHeader, nHeaderIndex ) ) - - // Process Groups - // Group - nPointer := Bin2W( hb_BSubStr( cParamsBuff, GRP_EXPR_OFFSET, 2 ) ) - - IF ! Empty( cGroupExp := ::GetExpr( nPointer ) ) - - // Add a new group array - AAdd( aReport[ RPT_GROUPS ], Array( RGT_COUNT ) ) - - // Group expression - aReport[ RPT_GROUPS ][ 1 ][ RGT_TEXT ] := cGroupExp - aReport[ RPT_GROUPS ][ 1 ][ RGT_EXP ] := hb_macroBlock( cGroupExp ) - IF Used() - aReport[ RPT_GROUPS ][ 1 ][ RGT_TYPE ] := ; - ValType( Eval( aReport[ RPT_GROUPS ][ 1 ][ RGT_EXP ] ) ) - ENDIF - - // Group header - nPointer := Bin2W( hb_BSubStr( cParamsBuff, GRP_HDR_OFFSET, 2 ) ) - aReport[ RPT_GROUPS ][ 1 ][ RGT_HEADER ] := ::GetExpr( nPointer ) - - // Page eject after group - aReport[ RPT_GROUPS ][ 1 ][ RGT_AEJECT ] := iif( hb_BSubStr( cParamsBuff, ; - PE_OFFSET, 1 ) $ "YyTt", .T., .F. ) - - ENDIF - - // Subgroup - nPointer := Bin2W( hb_BSubStr( cParamsBuff, SUB_EXPR_OFFSET, 2 ) ) - - IF ! Empty( cSubGroupExp := ::GetExpr( nPointer ) ) - - // Add new group array - AAdd( aReport[ RPT_GROUPS ], Array( RGT_COUNT ) ) - - // Subgroup expression - aReport[ RPT_GROUPS ][ 2 ][ RGT_TEXT ] := cSubGroupExp - aReport[ RPT_GROUPS ][ 2 ][ RGT_EXP ] := hb_macroBlock( cSubGroupExp ) - IF Used() - aReport[ RPT_GROUPS ][ 2 ][ RGT_TYPE ] := ; - ValType( Eval( aReport[ RPT_GROUPS ][ 2 ][ RGT_EXP ] ) ) - ENDIF - - // Subgroup header - nPointer := Bin2W( hb_BSubStr( cParamsBuff, SUB_HDR_OFFSET, 2 ) ) - aReport[ RPT_GROUPS ][ 2 ][ RGT_HEADER ] := ::GetExpr( nPointer ) - - // Page eject after subgroup - aReport[ RPT_GROUPS ][ 2 ][ RGT_AEJECT ] := .F. - - ENDIF - - // Process columns - nFieldOffset := 12 // dBASE skips first 12 byte fields block. - FOR nCount := 1 TO nColCount - - AAdd( aReport[ RPT_COLUMNS ], ::GetColumn( cFieldsBuff, @nFieldOffset ) ) - - NEXT - + FClose( nFrmHandle ) ENDIF RETURN aReport @@ -1122,7 +1029,6 @@ METHOD LoadReportFile( cFrmFile AS STRING ) CLASS HBReportForm * 1. The expression is empty if: * a. Passed pointer is equal to 65535 * b. Character following character pointed to by pointer is Chr( 0 ) -* */ METHOD GetExpr( nPointer AS NUMERIC ) CLASS HBReportForm @@ -1158,7 +1064,7 @@ METHOD GetExpr( nPointer AS NUMERIC ) CLASS HBReportForm // dBASE does this so we must do it too // Character following character pointed to by pointer is NULL - IF Chr( 0 ) == hb_BLeft( cString, 1 ) .AND. Len( hb_BLeft( cString, 1 ) ) == 1 + IF hb_BLeft( cString, 1 ) == hb_BChar( 0 ) cString := "" ENDIF ENDIF @@ -1170,7 +1076,7 @@ STATIC FUNCTION Occurs( cSearch, cTarget ) LOCAL nPos, nCount := 0 DO WHILE ! Empty( cTarget ) - IF ( nPos := At( cSearch, cTarget ) ) != 0 + IF ( nPos := At( cSearch, cTarget ) ) > 0 nCount++ cTarget := SubStr( cTarget, nPos + 1 ) ELSE @@ -1185,7 +1091,6 @@ STATIC FUNCTION XMLCOUNT( cString, nLineLength, nTabSize, lWrap ) hb_default( @nLineLength, 79 ) hb_default( @nTabSize, 4 ) - hb_default( @lWrap, .T. ) IF nTabSize >= nLineLength nTabSize := nLineLength - 1 @@ -1194,18 +1099,13 @@ STATIC FUNCTION XMLCOUNT( cString, nLineLength, nTabSize, lWrap ) RETURN MLCount( RTrim( cString ), nLineLength, nTabSize, lWrap ) /*** -* * XMEMOLINE( , [], [], -* [], [] ) --> cLine -* +* [], [] ) --> cLine */ - STATIC FUNCTION XMEMOLINE( cString, nLineLength, nLineNumber, nTabSize, lWrap ) hb_default( @nLineLength, 79 ) - hb_default( @nLineNumber, 1 ) hb_default( @nTabSize, 4 ) - hb_default( @lWrap, .T. ) IF nTabSize >= nLineLength nTabSize := nLineLength - 1 @@ -1226,20 +1126,12 @@ STATIC FUNCTION ParseHeader( cHeaderString, nFields ) cItem := Left( cHeaderString, nHeaderLen ) // check for explicit delimiter - nPos := At( ";", cItem ) - - IF ! Empty( nPos ) + IF ( nPos := At( ";", cItem ) ) > 0 // delimiter present AAdd( aPageHeader, Left( cItem, nPos - 1 ) ) ELSE - IF Empty( cItem ) - // empty string for S87 and 5.0 compatibility - AAdd( aPageHeader, "" ) - ELSE - // exception - AAdd( aPageHeader, cItem ) - - ENDIF + // empty string handling for S87 and 5.0 compatibility + AAdd( aPageHeader, iif( Empty( cItem ), "", cItem ) ) // empty or not, we jump past the field nPos := nHeaderLen ENDIF @@ -1260,21 +1152,19 @@ STATIC FUNCTION ParseHeader( cHeaderString, nFields ) * 1. The Header or Contents expressions are empty if: * a. Passed pointer is equal to 65535 * b. Character following character pointed to by pointer is Chr( 0 ) -* */ -METHOD GetColumn( cFieldsBuffer AS STRING, nOffset AS NUMERIC ) CLASS HBReportForm +METHOD GetColumn( cFieldsBuffer AS STRING, /* @ */ nOffset AS NUMERIC ) CLASS HBReportForm - LOCAL nPointer, aColumn[ RCT_COUNT ], cType, cExpr + LOCAL aColumn[ RCT_COUNT ] // Column width - aColumn[ RCT_WIDTH ] := Bin2W( hb_BSubStr( cFieldsBuffer, nOffset + ; FIELD_WIDTH_OFFSET, 2 ) ) // Total column? - aColumn[ RCT_TOTAL ] := iif( hb_BSubStr( cFieldsBuffer, nOffset + ; - FIELD_TOTALS_OFFSET, 1 ) $ "YyTt", .T., .F. ) + aColumn[ RCT_TOTAL ] := ; + hb_BSubStr( cFieldsBuffer, nOffset + FIELD_TOTALS_OFFSET, 1 ) $ "YyTt" // Decimals width aColumn[ RCT_DECIMALS ] := Bin2W( hb_BSubStr( cFieldsBuffer, nOffset + ; @@ -1284,24 +1174,18 @@ METHOD GetColumn( cFieldsBuffer AS STRING, nOffset AS NUMERIC ) CLASS HBReportFo // expression area via array OFFSETS[] // Content expression - nPointer := Bin2W( hb_BSubStr( cFieldsBuffer, nOffset + ; - FIELD_CONTENT_EXPR_OFFSET, 2 ) ) - aColumn[ RCT_TEXT ] := ::GetExpr( nPointer ) - cExpr := aColumn[ RCT_TEXT ] - aColumn[ RCT_EXP ] := hb_macroBlock( cExpr ) + aColumn[ RCT_TEXT ] := ::GetExpr( Bin2W( ; + hb_BSubStr( cFieldsBuffer, nOffset + FIELD_CONTENT_EXPR_OFFSET, 2 ) ) ) + aColumn[ RCT_EXP ] := hb_macroBlock( aColumn[ RCT_TEXT ] ) // Header expression - nPointer := Bin2W( hb_BSubStr( cFieldsBuffer, nOffset + ; - FIELD_HEADER_EXPR_OFFSET, 2 ) ) - - aColumn[ RCT_HEADER ] := ListAsArray( ::GetExpr( nPointer ), ";" ) + aColumn[ RCT_HEADER ] := hb_ATokens( ::GetExpr( Bin2W( ; + hb_BSubStr( cFieldsBuffer, nOffset + FIELD_HEADER_EXPR_OFFSET, 2 ) ) ), ";" ) // Column picture // Setup picture only if a database file is open IF Used() - cType := ValType( Eval( aColumn[ RCT_EXP ] ) ) - aColumn[ RCT_TYPE ] := cType - SWITCH cType + SWITCH aColumn[ RCT_TYPE ] := ValType( Eval( aColumn[ RCT_EXP ] ) ) CASE "C" CASE "M" aColumn[ RCT_PICT ] := Replicate( "X", aColumn[ RCT_WIDTH ] ) @@ -1314,7 +1198,8 @@ METHOD GetColumn( cFieldsBuffer AS STRING, nOffset AS NUMERIC ) CLASS HBReportFo EXIT CASE "N" IF aColumn[ RCT_DECIMALS ] != 0 - aColumn[ RCT_PICT ] := Replicate( "9", aColumn[ RCT_WIDTH ] - aColumn[ RCT_DECIMALS ] -1 ) + "." + ; + aColumn[ RCT_PICT ] := ; + Replicate( "9", aColumn[ RCT_WIDTH ] - aColumn[ RCT_DECIMALS ] - 1 ) + "." + ; Replicate( "9", aColumn[ RCT_DECIMALS ] ) ELSE aColumn[ RCT_PICT ] := Replicate( "9", aColumn[ RCT_WIDTH ] ) @@ -1331,79 +1216,24 @@ METHOD GetColumn( cFieldsBuffer AS STRING, nOffset AS NUMERIC ) CLASS HBReportFo RETURN aColumn -/*** -* -* ListAsArray( , ) --> aList -* Convert a delimited string to an array -* -*/ - -STATIC FUNCTION ListAsArray( cList, cDelimiter ) - - LOCAL nPos - LOCAL aList := {} // Define an empty array - LOCAL lDelimLast := .F. - - hb_default( @cDelimiter, "," ) - - DO WHILE Len( cList ) != 0 - - nPos := At( cDelimiter, cList ) - - IF nPos == 0 - nPos := Len( cList ) - ENDIF - - IF SubStr( cList, nPos, 1 ) == cDelimiter - lDelimLast := .T. - AAdd( aList, Left( cList, nPos - 1 ) ) // Add a new element - ELSE - lDelimLast := .F. - AAdd( aList, Left( cList, nPos ) ) // Add a new element - ENDIF - - cList := SubStr( cList, nPos + 1 ) - - ENDDO - - IF lDelimLast - AAdd( aList, "" ) - ENDIF - - RETURN aList // Return the array - STATIC FUNCTION MakeAStr( uVar, cType ) - LOCAL cString - SWITCH Asc( cType ) CASE Asc( "D" ) - CASE Asc( "d" ) - cString := DToC( uVar ) - EXIT + CASE Asc( "d" ) ; RETURN DToC( uVar ) CASE Asc( "T" ) - CASE Asc( "t" ) - cString := hb_TToC( uVar ) - EXIT + CASE Asc( "t" ) ; RETURN hb_TToC( uVar ) CASE Asc( "L" ) - CASE Asc( "l" ) - cString := iif( uVar, "T", "F" ) - EXIT + CASE Asc( "l" ) ; RETURN iif( uVar, "T", "F" ) CASE Asc( "N" ) - CASE Asc( "n" ) - cString := Str( uVar ) - EXIT + CASE Asc( "n" ) ; RETURN Str( uVar ) CASE Asc( "C" ) CASE Asc( "c" ) CASE Asc( "M" ) - CASE Asc( "m" ) - cString := uVar - EXIT - OTHERWISE - cString := "INVALID EXPRESSION" + CASE Asc( "m" ) ; RETURN uVar ENDSWITCH - RETURN cString + RETURN "INVALID EXPRESSION" FUNCTION __ReportForm( cFRMName, lPrinter, cAltFile, lNoConsole, bFor, ; bWhile, nNext, nRecord, lRest, lPlain, cHeading, ;