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

2008-10-05 20:10 UTC+0200 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* common.mak
   * source/rtl/Makefile
   - source/rtl/persist.prg
   + source/rtl/tpersist.prg
   - source/rtl/symbol.prg
   + source/rtl/tsymbol.prg
   * source/rtl/achoice.prg
   * source/rtl/browse.prg
   * source/rtl/dbedit.prg
   * source/rtl/dircmd.prg
   * source/rtl/einstv52.prg
   * source/rtl/einstvar.prg
   * source/rtl/hbini.prg
   * source/rtl/tbrowse.prg
   * source/rtl/tclass.prg
   * source/rtl/tget.prg
   * source/rtl/tgetint.prg
   * source/rtl/tlabel.prg
   * source/rtl/tobject.prg
   * source/rtl/treport.prg
   * source/rtl/typefile.prg
   * source/rtl/valtoexp.prg
   * source/rdd/usrrdd/example/exhsx.prg
   * source/rdd/usrrdd/example/exfcm.prg
   * source/rdd/usrrdd/rdds/hscdx.prg
     * Some formattings and cleanup.

   * source/rtl/tclass.prg
     % ValType() optimizations.

   * source/rtl/tlabel.prg
   * source/rtl/treport.prg
     * Trim() -> RTrim()

   * source/rtl/treport.prg
     ! Hard-coded Chr(13)+Chr(10) fixed in treport.prg.
This commit is contained in:
Viktor Szakats
2008-10-05 18:13:15 +00:00
parent e2768457a0
commit 4f330c58bc
24 changed files with 402 additions and 368 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
harbour/ChangeLog
View File

@@ -8,6 +8,44 @@
2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org)
*/
2008-10-05 20:10 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
* common.mak
* source/rtl/Makefile
- source/rtl/persist.prg
+ source/rtl/tpersist.prg
- source/rtl/symbol.prg
+ source/rtl/tsymbol.prg
* source/rtl/achoice.prg
* source/rtl/browse.prg
* source/rtl/dbedit.prg
* source/rtl/dircmd.prg
* source/rtl/einstv52.prg
* source/rtl/einstvar.prg
* source/rtl/hbini.prg
* source/rtl/tbrowse.prg
* source/rtl/tclass.prg
* source/rtl/tget.prg
* source/rtl/tgetint.prg
* source/rtl/tlabel.prg
* source/rtl/tobject.prg
* source/rtl/treport.prg
* source/rtl/typefile.prg
* source/rtl/valtoexp.prg
* source/rdd/usrrdd/example/exhsx.prg
* source/rdd/usrrdd/example/exfcm.prg
* source/rdd/usrrdd/rdds/hscdx.prg
* Some formattings and cleanup.
* source/rtl/tclass.prg
% ValType() optimizations.
* source/rtl/tlabel.prg
* source/rtl/treport.prg
* Trim() -> RTrim()
* source/rtl/treport.prg
! Hard-coded Chr(13)+Chr(10) fixed in treport.prg.
2008-10-05 18:46 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
* contrib/hbwin/win_ole.c
* source/rtl/wait.prg

4
harbour/common.mak
View File

@@ -628,7 +628,6 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\menusys$(OBJEXT) \
$(OBJ_DIR)\objfunc$(OBJEXT) \
$(OBJ_DIR)\perfuncs$(OBJEXT) \
$(OBJ_DIR)\persist$(OBJEXT) \
$(OBJ_DIR)\profiler$(OBJEXT) \
$(OBJ_DIR)\pushbtn$(OBJEXT) \
$(OBJ_DIR)\radiobtn$(OBJEXT) \
@@ -638,7 +637,6 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\scrollbr$(OBJEXT) \
$(OBJ_DIR)\setfunc$(OBJEXT) \
$(OBJ_DIR)\setta$(OBJEXT) \
$(OBJ_DIR)\symbol$(OBJEXT) \
$(OBJ_DIR)\tbcolumn$(OBJEXT) \
$(OBJ_DIR)\tbrowse$(OBJEXT) \
$(OBJ_DIR)\tbrowsys$(OBJEXT) \
@@ -652,8 +650,10 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\tmenuitm$(OBJEXT) \
$(OBJ_DIR)\tmenusys$(OBJEXT) \
$(OBJ_DIR)\tobject$(OBJEXT) \
$(OBJ_DIR)\tpersist$(OBJEXT) \
$(OBJ_DIR)\tpopup$(OBJEXT) \
$(OBJ_DIR)\treport$(OBJEXT) \
$(OBJ_DIR)\tsymbol$(OBJEXT) \
$(OBJ_DIR)\tscalar$(OBJEXT) \
$(OBJ_DIR)\ttextlin$(OBJEXT) \
$(OBJ_DIR)\tthreadx$(OBJEXT) \

4
harbour/source/rdd/usrrdd/example/exfcm.prg
View File

@@ -15,7 +15,7 @@ PROCEDURE MAIN()
DBGOTOP()
? RECNO(), '"' + FIELD->LINE + '"'
WAIT
WHILE !EOF()
DO WHILE !EOF()
? RECNO(), '"' + FIELD->LINE + '"'
IF RECNO()==20
INKEY(0)
@@ -29,7 +29,7 @@ PROCEDURE MAIN()
? "ALIAS", ALIAS(), "RECNO", RECNO(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC()
WAIT
WHILE !BOF()
DO WHILE !BOF()
? RECNO(), '[' + FIELD->LINE + ']'
IF RECNO()==LASTREC()-20
INKEY(0)

2
harbour/source/rdd/usrrdd/example/exhsx.prg
View File

@@ -29,7 +29,7 @@ PROCEDURE MAIN()
/* Look for all records which have 'SHERMAN' string inside */
hs := HSX_HANDLE( "_tst" )
HS_SET( hs, "SHERMAN" )
WHILE ( n := HS_NEXT( hs ) ) > 0
DO WHILE ( n := HS_NEXT( hs ) ) > 0
DBGOTO( n )
IF HS_VERIFY( hs ) > 0
? RTRIM( FIRST+LAST+STREET+CITY )

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

@@ -110,7 +110,7 @@ STATIC FUNCTION _HSX_GOCOLD( nWA )
/* update HSX indexes */
FOR EACH nHSX IN aWData[ 2 ]
nKeyNo := HS_KEYCOUNT( nHSX )
WHILE nKeyNo >= 0 .AND. nKeyNo < nRecNo
DO WHILE nKeyNo >= 0 .AND. nKeyNo < nRecNo
nKeyNo := HS_ADD( nHSX, "" )
ENDDO
IF nKeyNo >= nRecNo

4
harbour/source/rtl/Makefile
View File

@@ -189,7 +189,6 @@ PRG_SOURCES=\
menusys.prg \
objfunc.prg \
perfuncs.prg \
persist.prg \
profiler.prg \
pushbtn.prg \
radiobtn.prg \
@@ -199,7 +198,6 @@ PRG_SOURCES=\
scrollbr.prg \
setfunc.prg \
setta.prg \
symbol.prg \
tclass.prg \
tbcolumn.prg \
tbrowse.prg \
@@ -213,9 +211,11 @@ PRG_SOURCES=\
tmenuitm.prg \
tmenusys.prg \
tobject.prg \
tpersist.prg \
tpopup.prg \
treport.prg \
tscalar.prg \
tsymbol.prg \
ttextlin.prg \
tthreadx.prg \
ttopbar.prg \

8
harbour/source/rtl/achoice.prg
View File

@@ -75,10 +75,10 @@ FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPo
nNumRows := nBottom - nTop + 1
IF VALTYPE( xSelect ) $ "A"
IF ValType( xSelect ) $ "A"
alSelect := xSelect
ELSE
alSelect := ARRAY( LEN( acItems ) )
alSelect := Array( Len( acItems ) )
AFill( alSelect, xSelect )
ENDIF
@@ -140,7 +140,7 @@ FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPo
nPos := BETWEEN( nFrstItem, nPos, nLastItem )
ENDIF
nAtTop := MIN( nAtTop, nPos )
nAtTop := Min( nAtTop, nPos )
IF nAtTop + nNumRows - 1 > nItems
nAtTop := BETWEEN( 1, nPos - nNumRows + 1, nItems - nNumRows + 1 )
@@ -500,7 +500,7 @@ FUNCTION AChoice( nTop, nLeft, nBottom, nRight, acItems, xSelect, xUserFunc, nPo
nPos := BETWEEN( nFrstItem, nPos, nLastItem )
ENDIF
nAtTop := MIN( nAtTop, nPos )
nAtTop := Min( nAtTop, nPos )
IF nAtTop + nNumRows - 1 > nItems
nAtTop := BETWEEN( 1, nPos - nNumRows + 1, nItems - nNumRows + 1 )

20
harbour/source/rtl/browse.prg
View File

@@ -121,7 +121,7 @@ FUNCTION Browse( nTop, nLeft, nBottom, nRight )
dbGoBottom()
ELSE
lAppend := .T.
SetCursor( IIF( ReadInsert(), SC_INSERT, SC_NORMAL ) )
SetCursor( iif( ReadInsert(), SC_INSERT, SC_NORMAL ) )
ENDIF
oBrw:Down()
oBrw:ForceStable()
@@ -238,7 +238,7 @@ FUNCTION Browse( nTop, nLeft, nBottom, nRight )
CASE K_INS
IF lAppend
SetCursor( IIF( ReadInsert( ! ReadInsert() ), ;
SetCursor( iif( ReadInsert( ! ReadInsert() ), ;
SC_NORMAL, SC_INSERT ) )
ENDIF
EXIT
@@ -301,10 +301,10 @@ STATIC PROCEDURE StatLine( oBrw, lAppend )
DispOutAt( nTop, nRight - 40, " " )
DispOutAt( nTop, nRight - 20, " <new>" )
ELSE
DispOutAt( nTop, nRight - 40, IIF( Deleted(), "<Deleted>", " " ) )
DispOutAt( nTop, nRight - 40, iif( Deleted(), "<Deleted>", " " ) )
DispOutAt( nTop, nRight - 20, PadR( LTrim( Str( RecNo() ) ) + "/" + ;
LTrim( Str( LastRec() ) ), 16 ) + ;
IIF( oBrw:HitTop(), "<bof>", " " ) )
iif( oBrw:HitTop(), "<bof>", " " ) )
ENDIF
RETURN
@@ -322,9 +322,9 @@ STATIC FUNCTION DoGet( oBrw, lAppend )
lScore := Set( _SET_SCOREBOARD, .F. )
lExit := Set( _SET_EXIT, .T. )
bIns := SetKey( K_INS, {|| SetCursor( IIF( ReadInsert( ! ReadInsert() ), ;
bIns := SetKey( K_INS, {|| SetCursor( iif( ReadInsert( ! ReadInsert() ), ;
SC_NORMAL, SC_INSERT ) ) } )
nCursor := SetCursor( IIF( ReadInsert(), SC_INSERT, SC_NORMAL ) )
nCursor := SetCursor( iif( ReadInsert(), SC_INSERT, SC_NORMAL ) )
IF !Empty( cIndexKey := IndexKey( 0 ) )
xKeyValue := &cIndexKey
ENDIF
@@ -332,7 +332,7 @@ STATIC FUNCTION DoGet( oBrw, lAppend )
oCol := oBrw:GetColumn( oBrw:ColPos )
xValue := Eval( oCol:Block )
oGet := GetNew( Row(), Col(), ;
{ |xNewVal| IIF( PCount() == 0, xValue, xValue := xNewVal ) }, ;
{ |xNewVal| iif( PCount() == 0, xValue, xValue := xNewVal ) }, ;
"mGetVar", NIL, oBrw:ColorSpec )
lSuccess := .F.
IF ReadModal( { oGet } )
@@ -376,18 +376,18 @@ STATIC FUNCTION ExitKey( lAppend )
SWITCH nKey
CASE K_PGDN
nKey := IIF( lAppend, 0, K_DOWN )
nKey := iif( lAppend, 0, K_DOWN )
EXIT
CASE K_PGUP
nKey := IIF( lAppend, 0, K_UP )
nKey := iif( lAppend, 0, K_UP )
CASE K_DOWN
CASE K_UP
EXIT
OTHERWISE
nKey := IIF( nKey == 13 .OR. ;
nKey := iif( nKey == 13 .OR. ;
( nKey >= 32 .AND. nKey <= 255 ), K_RIGHT, 0 )
EXIT
ENDSWITCH

22
harbour/source/rtl/dbedit.prg
View File

@@ -198,9 +198,9 @@ FUNCTION DBEDIT( nTop, nLeft, nBottom, nRight, ;
lDoIdleCall := .T.
lContinue := .T.
WHILE lContinue
DO WHILE lContinue
WHILE ! oBrowse:stabilize()
DO WHILE ! oBrowse:stabilize()
nKey := Nextkey()
#ifdef HB_COMPAT_C53
IF nKey != 0 .AND. nKey != K_MOUSEMOVE
@@ -219,7 +219,7 @@ FUNCTION DBEDIT( nTop, nLeft, nBottom, nRight, ;
IF lContinue .AND. lFlag
oBrowse:hiLite()
#ifdef HB_COMPAT_C53
WHILE ( nKey := Inkey( 0 ) ) == K_MOUSEMOVE
DO WHILE ( nKey := Inkey( 0 ) ) == K_MOUSEMOVE
ENDDO
#else
nKey := Inkey( 0 )
@@ -296,10 +296,10 @@ STATIC FUNCTION CallUser( oBrowse, xUserFunc, nKey, lAppend, lFlag )
LOCAL nPrevRecNo
LOCAL nAction
LOCAL nMode := IIF( nKey != 0, DE_EXCEPT, ;
IIF( !lAppend .AND. IsDbEmpty(), DE_EMPTY, ;
IIF( oBrowse:hitBottom, DE_HITBOTTOM, ;
IIF( oBrowse:hitTop, DE_HITTOP, DE_IDLE ) ) ) )
LOCAL nMode := iif( nKey != 0, DE_EXCEPT, ;
iif( !lAppend .AND. IsDbEmpty(), DE_EMPTY, ;
iif( oBrowse:hitBottom, DE_HITBOTTOM, ;
iif( oBrowse:hitTop, DE_HITTOP, DE_IDLE ) ) ) )
oBrowse:forceStable()
@@ -308,11 +308,11 @@ STATIC FUNCTION CallUser( oBrowse, xUserFunc, nKey, lAppend, lFlag )
/* NOTE: CA-Cl*pper won't check the type of the return value here,
and will crash if it's a non-NIL, non-numeric type. We're
replicating this behavior. */
nAction := IIF( ISBLOCK( xUserFunc ), ;
nAction := iif( ISBLOCK( xUserFunc ), ;
Eval( xUserFunc, nMode, oBrowse:colPos ), ;
IIF( ISCHARACTER( xUserFunc ) .AND. !Empty( xUserFunc ), ;
iif( ISCHARACTER( xUserFunc ) .AND. !Empty( xUserFunc ), ;
&xUserFunc( nMode, oBrowse:colPos ), ;
IIF( nKey == K_ENTER .OR. nKey == K_ESC, DE_ABORT, DE_CONT ) ) )
iif( nKey == K_ENTER .OR. nKey == K_ESC, DE_ABORT, DE_CONT ) ) )
IF !lAppend .AND. EOF() .AND. !IsDbEmpty()
dbSkip( -1 )
@@ -348,7 +348,7 @@ STATIC FUNCTION CallUser( oBrowse, xUserFunc, nKey, lAppend, lFlag )
nPrevRecNo := RecNo()
oBrowse:refreshAll():forceStable()
WHILE nPrevRecNo != RecNo()
DO WHILE nPrevRecNo != RecNo()
oBrowse:Up():forceStable()
ENDDO

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

@@ -105,9 +105,9 @@ STATIC PROCEDURE PutDBF( aDirEntry )
Asc( buffer ) ) != 0
nRecCount := Bin2L( SubStr( buffer, 5, 4 ) )
dLastUpdate := hb_SToD( StrZero( ASC( SubStr( buffer, 2, 1 ) ) + 1900, 4 ) +;
StrZero( ASC( SubStr( buffer, 3, 1 ) ), 2 ) +;
StrZero( ASC( SubStr( buffer, 4, 1 ) ), 2 ) )
dLastUpdate := hb_SToD( StrZero( Asc( SubStr( buffer, 2, 1 ) ) + 1900, 4 ) +;
StrZero( Asc( SubStr( buffer, 3, 1 ) ), 2 ) +;
StrZero( Asc( SubStr( buffer, 4, 1 ) ), 2 ) )
ENDIF

8
harbour/source/rtl/einstv52.prg
View File

@@ -60,7 +60,7 @@ FUNCTION __eInstVar52( oVar, cMethod, xValue, cType, nSubCode, xMin, xMax )
LOCAL oError
LOCAL lError
IF VALTYPE( xValue ) == cType
IF ValType( xValue ) == cType
lError := .F.
IF xMin != NIL
lError := !( xValue >= xMin )
@@ -76,7 +76,7 @@ FUNCTION __eInstVar52( oVar, cMethod, xValue, cType, nSubCode, xMin, xMax )
IF lError
oError := ErrorNew()
oError:description := HB_LANGERRMSG( 1 )
oError:description := hb_langErrMsg( 1 )
oError:gencode := 1
oError:severity := 2
oError:cansubstitute := .T.
@@ -88,8 +88,8 @@ FUNCTION __eInstVar52( oVar, cMethod, xValue, cType, nSubCode, xMin, xMax )
#endif
oError:subcode := nSubCode
oError:args := { xValue }
xValue := EVAL( ERRORBLOCK(), oError )
IF !( VALTYPE( xValue ) == cType )
xValue := Eval( ErrorBlock(), oError )
IF !( ValType( xValue ) == cType )
__errInHandler()
ENDIF
ENDIF

10
harbour/source/rtl/einstvar.prg
View File

@@ -59,10 +59,10 @@ FUNCTION __eInstVar53( oVar, cMethod, xValue, cType, nSubCode, bValid )
LOCAL oError
IF !( VALTYPE( xValue ) == cType ) .OR. ;
( bValid != NIL .AND. !EVAL( bValid, oVar, xValue ) )
IF !( ValType( xValue ) == cType ) .OR. ;
( bValid != NIL .AND. !Eval( bValid, oVar, xValue ) )
oError := ErrorNew()
oError:description := HB_LANGERRMSG( 1 )
oError:description := hb_langErrMsg( 1 )
oError:gencode := 1
oError:severity := 2
oError:cansubstitute := .T.
@@ -74,8 +74,8 @@ FUNCTION __eInstVar53( oVar, cMethod, xValue, cType, nSubCode, bValid )
#endif
oError:subcode := nSubCode
oError:args := { xValue }
xValue := EVAL( ERRORBLOCK(), oError )
IF !( VALTYPE( xValue ) == cType )
xValue := Eval( ErrorBlock(), oError )
IF !( ValType( xValue ) == cType )
__errInHandler()
ENDIF
ENDIF

2
harbour/source/rtl/hbini.prg
View File

@@ -299,7 +299,7 @@ FUNCTION hb_IniWrite( xFileName, hIni, cCommentBegin, cCommentEnd, lAutoMain )
ELSE
/* When automain is off, just write all the toplevel variables. */
hb_HEval( hIni, { |cKey, xVal| IIF( ! hb_IsHash( xVal ),;
hb_HEval( hIni, { |cKey, xVal| iif( ! hb_IsHash( xVal ),;
FWrite( hFile, hb_CStr( cKey ) + " = " + ;
hb_CStr( xVal ) + cNewLine ), /* nothing */ ) } )
ENDIF

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

@@ -338,7 +338,7 @@ METHOD new( nTop, nLeft, nBottom, nRight ) CLASS TBROWSE
STATIC FUNCTION _SKIP_RESULT( xResult )
RETURN IIF( ValType( xResult ) == "N", Int( xResult ), 0 )
RETURN iif( ValType( xResult ) == "N", Int( xResult ), 0 )
STATIC PROCEDURE _DISP_FHSEP( nRow, nType, cColor, aColData )
@@ -436,7 +436,7 @@ STATIC PROCEDURE _DISP_FHNAME( nRow, nHeight, nLeft, nRight, nType, nColor, aCol
FOR nPos := 1 TO nHeight
DispOutAt( nRow + nPos - 1, nCol, ;
PadR( hb_tokenGet( cName, nPos, _TBR_CHR_LINEDELIMITER ), nWidth ), ;
IIF( aCol[ _TBCI_DEFCOLOR ][ nColor ] == 0, "N/N", ;
iif( aCol[ _TBCI_DEFCOLOR ][ nColor ] == 0, "N/N", ;
aColors[ aCol[ _TBCI_DEFCOLOR ][ nColor ] ] ) )
NEXT
ENDIF
@@ -459,7 +459,7 @@ METHOD dispFrames() CLASS TBROWSE
IF ::nHeadHeight > 0
_DISP_FHNAME( ::n_Top, ::nHeadHeight, ::n_Left, ::n_Right, _TBCI_HEADING, ;
IIF( ::lHeadSep, _TBC_CLR_HEADING, _TBC_CLR_STANDARD ), ;
iif( ::lHeadSep, _TBC_CLR_HEADING, _TBC_CLR_STANDARD ), ;
::aColors, ::aColData )
ENDIF
IF ::lHeadSep
@@ -472,7 +472,7 @@ METHOD dispFrames() CLASS TBROWSE
ENDIF
IF ::nFootHeight > 0
_DISP_FHNAME( ::n_Bottom - ::nFootHeight + 1, ::nFootHeight, ::n_Left, ::n_Right, _TBCI_FOOTING, ;
IIF( ::lFootSep, _TBC_CLR_FOOTING, _TBC_CLR_STANDARD ), ;
iif( ::lFootSep, _TBC_CLR_FOOTING, _TBC_CLR_STANDARD ), ;
::aColors, ::aColData )
ENDIF
@@ -495,7 +495,7 @@ METHOD dispRow( nRow ) CLASS TBROWSE
DispBegin()
nRowPos := ::n_Top + ::nHeadHeight + IIF( ::lHeadSep, 1, 0 ) + nRow - 1
nRowPos := ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 1, 0 ) + nRow - 1
cStdColor := ::colorValue( _TBC_CLR_STANDARD )
DispBox( nRowPos, ::n_Left, nRowPos, ::n_Right, Space( 9 ), cStdColor )
@@ -581,12 +581,12 @@ METHOD scrollBuffer( nRows ) CLASS TBROWSE
AFill( ::aCellStatus, .F. )
ELSE
cOldColor := SetColor( ::colorValue( _TBC_CLR_STANDARD ) )
Scroll( ::n_Top + ::nHeadHeight + IIF( ::lHeadSep, 1, 0 ), ::n_Left, ;
::n_Bottom - ::nFootHeight - IIF( ::lFootSep, 1, 0 ), ::n_Right, ;
Scroll( ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 1, 0 ), ::n_Left, ;
::n_Bottom - ::nFootHeight - iif( ::lFootSep, 1, 0 ), ::n_Right, ;
nRows )
SetColor( cOldColor )
IF nRows > 0
WHILE --nRows >= 0
DO WHILE --nRows >= 0
aValues := ::aCellValues[ 1 ]
aColors := ::aCellColors[ 1 ]
ADel( ::aCellValues, 1 )
@@ -599,7 +599,7 @@ METHOD scrollBuffer( nRows ) CLASS TBROWSE
::aDispStatus[ nRowCount ] := .T.
ENDDO
ELSEIF nRows < 0
WHILE ++nRows <= 0
DO WHILE ++nRows <= 0
HB_AIns( ::aCellValues, 1, ATail( ::aCellValues ) )
HB_AIns( ::aCellColors, 1, ATail( ::aCellColors ) )
HB_AIns( ::aCellStatus, 1, .F. )
@@ -864,14 +864,14 @@ METHOD forceStable() CLASS TBROWSE
* be changed. I'll change it in the future but first I will have
* to revert my stupid modifications in Harbour core code. Looking
* at old TBrowse implementation I replaced some:
* WHILE !oBrw:stabilize(); END
* DO WHILE !oBrw:stabilize(); END
* with:
* oBrw:forceStable()
* In Clipper it's not the same because oBrw:forceStable()
* may not set cursor position and only ::stabilize() does it.
* [druzus]
*/
WHILE !::stabilize()
DO WHILE !::stabilize()
ENDDO
RETURN Self
@@ -938,7 +938,7 @@ STATIC FUNCTION _DECODECOLORS( cColorSpec )
* definitions and use a little bit different rules. [druzus]
*/
IF nPos <= 2 .AND. hb_colorToN( cColor ) == -1
cColor := IIF( nPos == 1, "W/N", "N/W" )
cColor := iif( nPos == 1, "W/N", "N/W" )
ENDIF
AAdd( aColors, cColor )
NEXT
@@ -948,7 +948,7 @@ STATIC FUNCTION _DECODECOLORS( cColorSpec )
IF Len( aColors ) < 2
AAdd( aColors, "N/W" )
ENDIF
WHILE Len( aColors ) < _TBC_CLR_MAX
DO WHILE Len( aColors ) < _TBC_CLR_MAX
AAdd( aColors, aColors[ _TBC_CLR_STANDARD ] )
ENDDO
@@ -1029,11 +1029,11 @@ METHOD setCursorPos() CLASS TBROWSE
nCol >= 1 .AND. nCol <= ::colCount .AND. ;
( aCol := ::aColData[ nCol ] )[ _TBCI_COLPOS ] != NIL
::n_Row := ::n_Top + ::nHeadHeight + IIF( ::lHeadSep, 0, -1 ) + nRow
::n_Row := ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 0, -1 ) + nRow
::n_Col := ::aColData[ nCol ][ _TBCI_COLPOS ] + ;
::aColData[ nCol ][ _TBCI_CELLPOS ]
IF aCol[ _TBCI_SEPWIDTH ] > 0
WHILE --nCol >= 1
DO WHILE --nCol >= 1
IF ::aColData[ nCol ][ _TBCI_COLPOS ] != NIL
::n_Col += aCol[ _TBCI_SEPWIDTH ]
EXIT
@@ -1136,7 +1136,7 @@ METHOD pageDown() CLASS TBROWSE
METHOD left() CLASS TBROWSE
::setUnstable()
WHILE .T.
DO WHILE .T.
::nColPos--
IF ::nColPos < 1 .OR. ::nColPos > ::colCount .OR. ;
::aColData[ ::nColPos, _TBCI_CELLWIDTH ] != 0
@@ -1150,7 +1150,7 @@ METHOD left() CLASS TBROWSE
METHOD right() CLASS TBROWSE
::setUnstable()
WHILE .T.
DO WHILE .T.
::nColPos++
IF ::nColPos < 1 .OR. ::nColPos > ::colCount .OR. ;
::aColData[ ::nColPos, _TBCI_CELLWIDTH ] != 0
@@ -1164,7 +1164,7 @@ METHOD right() CLASS TBROWSE
METHOD home() CLASS TBROWSE
::setUnstable()
::nColPos := IIF( ::nLeftVisible < ::nRightVisible, ;
::nColPos := iif( ::nLeftVisible < ::nRightVisible, ;
::nLeftVisible, ::nRightVisible )
RETURN Self
@@ -1589,7 +1589,7 @@ STATIC FUNCTION _MAXFREEZE( nColumns, aColData, nWidth )
STATIC FUNCTION _NEXTCOLUMN( aColData, nCol )
LOCAL aCol
WHILE nCol <= LEN( aColData )
DO WHILE nCol <= LEN( aColData )
aCol := aColData[ nCol ]
IF aCol[ _TBCI_CELLWIDTH ] > 0
RETURN nCol
@@ -1603,7 +1603,7 @@ STATIC FUNCTION _NEXTCOLUMN( aColData, nCol )
STATIC FUNCTION _PREVCOLUMN( aColData, nCol )
LOCAL aCol
WHILE nCol >= 1
DO WHILE nCol >= 1
aCol := aColData[ nCol ]
IF aCol[ _TBCI_CELLWIDTH ] > 0
RETURN nCol
@@ -1649,7 +1649,7 @@ STATIC FUNCTION _SETCOLUMNS( nFrom, nTo, nStep, aColData, nFirst, nWidth, lFirst
NEXT
ENDIF
RETURN IIF( nLast == 0, nFrom - nStep, nLast )
RETURN iif( nLast == 0, nFrom - nStep, nLast )
STATIC PROCEDURE _SETVISIBLE( aColData, nWidth, nFrozen, nLeft, nRight )
@@ -1750,7 +1750,7 @@ METHOD setVisible() CLASS TBROWSE
ENDIF
ELSEIF ::nColPos <= ::nFrozen .AND. ::nLeftVisible == 0
nCol := _NEXTCOLUMN( ::aColData, ::nFrozen + 1 )
::nColPos := IIF( nCol == 0, nColumns, nCol )
::nColPos := iif( nCol == 0, nColumns, nCol )
ENDIF
_SETVISIBLE( ::aColData, @nWidth, ;
@@ -1768,7 +1768,7 @@ METHOD setVisible() CLASS TBROWSE
*/
IF ::nColPos >= 1 .AND. ::aColData[ ::nColPos ][ _TBCI_CELLWIDTH ] <= 0
nCol := _PREVCOLUMN( ::aColData, ::nColPos - 1 )
::nColPos := IIF( nCol == 0, _NEXTCOLUMN( ::aColData, ::nColPos + 1 ), nCol )
::nColPos := iif( nCol == 0, _NEXTCOLUMN( ::aColData, ::nColPos + 1 ), nCol )
ENDIF
#endif
@@ -1780,7 +1780,7 @@ METHOD setVisible() CLASS TBROWSE
IF aCol[ _TBCI_CELLWIDTH ] > 0 .AND. ;
( nCol <= ::nFrozen .OR. nCol >= ::nLeftVisible )
nFrozen := IIF( nCol == ::nLeftVisible, Int( nWidth / 2 ), 0 )
nFrozen := iif( nCol == ::nLeftVisible, Int( nWidth / 2 ), 0 )
nColPos := nLeft += nFrozen
nLeft += aCol[ _TBCI_COLWIDTH ]
IF lFirst
@@ -1788,7 +1788,7 @@ METHOD setVisible() CLASS TBROWSE
ELSE
nLeft += aCol[ _TBCI_SEPWIDTH ]
ENDIF
nLast := IIF( nCol == ::nRightVisible, _TBR_COORD( ::n_Right ) - nLeft + 1, 0 )
nLast := iif( nCol == ::nRightVisible, _TBR_COORD( ::n_Right ) - nLeft + 1, 0 )
IF aCol[ _TBCI_COLPOS ] != nColPos .OR. ;
aCol[ _TBCI_FROZENSPACE ] != nFrozen .OR. ;
@@ -1956,10 +1956,10 @@ METHOD rowCount() CLASS TBROWSE
ENDIF
nRows := _TBR_COORD( ::n_Bottom ) - _TBR_COORD( ::n_Top ) + 1 - ;
::nHeadHeight - IIF( ::lHeadSep, 1, 0 ) - ;
::nFootHeight - IIF( ::lFootSep, 1, 0 )
::nHeadHeight - iif( ::lHeadSep, 1, 0 ) - ;
::nFootHeight - iif( ::lFootSep, 1, 0 )
RETURN IIF( nRows > 0, nRows, 0 )
RETURN iif( nRows > 0, nRows, 0 )
/* NOTE: CA-Cl*pper has a bug where negative nRowPos value will be translated
@@ -1972,8 +1972,8 @@ METHOD setRowPos( nRowPos ) CLASS TBROWSE
IF ISNUMBER( nRowPos )
nRow := Int( nRowPos )
::nRowPos := IIF( nRow > nRowCount, nRowCount, ;
IIF( nRow < 1, 1, nRow ) )
::nRowPos := iif( nRow > nRowCount, nRowCount, ;
iif( nRow < 1, 1, nRow ) )
RETURN nRow
ELSE
::nRowPos := Min( nRowCount, 1 )
@@ -2221,7 +2221,7 @@ METHOD getColumn( nColumn ) CLASS TBROWSE
#ifdef HB_C52_STRICT
RETURN ::columns[ nColumn ]
#else
RETURN IIF( nColumn >= 1 .AND. nColumn <= ::colCount, ::columns[ nColumn ], NIL )
RETURN iif( nColumn >= 1 .AND. nColumn <= ::colCount, ::columns[ nColumn ], NIL )
#endif
@@ -2401,7 +2401,7 @@ METHOD firstScrCol() CLASS TBROWSE
// TOFIX
RETURN IIF( ::leftVisible == 0, 0, ::aColData[ ::leftVisible ][ _TBCI_COLPOS ] )
RETURN iif( ::leftVisible == 0, 0, ::aColData[ ::leftVisible ][ _TBCI_COLPOS ] )
#endif
@@ -2488,11 +2488,11 @@ METHOD hitTest( mRow, mCol ) CLASS TBROWSE
ELSE
nRet := HTCELL
#ifdef HB_BRW_STATICMOUSE
::mRowPos := mRow - nTop - ::nHeadHeight - IIF( ::lHeadSep, 1, 0 )
::mRowPos := mRow - nTop - ::nHeadHeight - iif( ::lHeadSep, 1, 0 )
#endif
lFirst := .T.
nCol := 1
WHILE nCol <= ::nRightVisible
DO WHILE nCol <= ::nRightVisible
aCol := ::aColData[ nCol ]
IF aCol[ _TBCI_COLPOS ] != NIL
IF lFirst
@@ -2540,16 +2540,16 @@ STATIC PROCEDURE _mBrwPos( oBrw, mRow, mCol )
mCol >= ( nLeft := _TBR_COORD( oBrw:n_Left ) ) .AND. ;
mCol <= ( nRight := _TBR_COORD( oBrw:n_Right ) )
IF mRow < nTop + oBrw:nHeadHeight + IIF( oBrw:lHeadSep, 1, 0 ) .OR. ;
mRow > nBottom - oBrw:nFootHeight - IIF( oBrw:lFootSep, 1, 0 )
IF mRow < nTop + oBrw:nHeadHeight + iif( oBrw:lHeadSep, 1, 0 ) .OR. ;
mRow > nBottom - oBrw:nFootHeight - iif( oBrw:lFootSep, 1, 0 )
mRow := 0
ELSE
mRow -= nTop + oBrw:nHeadHeight - IIF( oBrw:lHeadSep, 0, 1 )
mRow -= nTop + oBrw:nHeadHeight - iif( oBrw:lHeadSep, 0, 1 )
ENDIF
nPos := 0
nCol := 1
WHILE nCol <= oBrw:nRightVisible
DO WHILE nCol <= oBrw:nRightVisible
aCol := oBrw:aColData[ nCol ]
IF aCol[ _TBCI_COLPOS ] != NIL
IF nPos != 0
@@ -2742,21 +2742,21 @@ FUNCTION TBMouse( oBrw, nMRow, nMCol )
IF oBrw:hitTest( nMRow, nMCol ) == HTCELL
IF ( n := oBrw:mRowPos - oBrw:rowPos ) < 0
WHILE ++n <= 0
DO WHILE ++n <= 0
oBrw:up()
ENDDO
ELSEIF n > 0
WHILE --n >= 0
DO WHILE --n >= 0
oBrw:down()
ENDDO
ENDIF
IF ( n := oBrw:mColPos - oBrw:colPos ) < 0
WHILE ++n <= 0
DO WHILE ++n <= 0
oBrw:left()
ENDDO
ELSEIF n > 0
WHILE --n >= 0
DO WHILE --n >= 0
oBrw:right()
ENDDO
ENDIF

49
harbour/source/rtl/tclass.prg
View File

@@ -144,10 +144,10 @@ FUNCTION HBClass()
RETURN __clsInst( s_hClass )
// xSuper is used here as the new preprocessor file (hbclass.ch) send here
// always an array (if no superclass, this will be an empty one)
// In case of direct class creation (without the help of preprocessor) xSuper can be
// either NIL or contain the name of the superclass.
/* xSuper is used here as the new preprocessor file (hbclass.ch) send here
always an array (if no superclass, this will be an empty one)
In case of direct class creation (without the help of preprocessor) xSuper can be
either NIL or contain the name of the superclass. */
STATIC FUNCTION New( cClassName, xSuper, sClassFunc, lModuleFriendly )
@@ -158,19 +158,19 @@ STATIC FUNCTION New( cClassName, xSuper, sClassFunc, lModuleFriendly )
IF Empty( xSuper )
::asSuper := {}
ELSEIF VALTYPE( xSuper ) == "C"
ELSEIF ISCHARACTER( xSuper )
::asSuper := { __DynsN2Sym( xSuper ) }
ELSEIF VALTYPE( xSuper ) == "S"
ELSEIF hb_IsSymbol( xSuper )
::asSuper := { xSuper }
ELSEIF VALTYPE( xSuper ) == "A"
ELSEIF ISARRAY( xSuper )
::asSuper := {}
nSuper := Len( xSuper )
FOR i := 1 TO nSuper
IF !Empty( xSuper[ i ] )
IF VALTYPE( xSuper[ i ] ) == "C"
AADD( ::asSuper, __DynsN2Sym( xSuper[ i ] ) )
ELSEIF VALTYPE( xSuper[ i ] ) == "S"
AADD( ::asSuper, xSuper[ i ] )
IF ISCHARACTER( xSuper[ i ] )
AAdd( ::asSuper, __DynsN2Sym( xSuper[ i ] ) )
ELSEIF hb_IsSymbol( xSuper[ i ] )
AAdd( ::asSuper, xSuper[ i ] )
ENDIF
ENDIF
NEXT
@@ -197,7 +197,7 @@ STATIC PROCEDURE Create()
LOCAL Self := QSelf()
LOCAL n
LOCAL nLenDatas := Len( ::aDatas ) //Datas local to the class !!
LOCAL nLenDatas := Len( ::aDatas ) /* Datas local to the class !! */
LOCAL nLen := Len( ::asSuper )
LOCAL nClassBegin
LOCAL hClass
@@ -206,7 +206,7 @@ STATIC PROCEDURE Create()
/* Self:Class := MetaClass */
FOR n := 1 TO nLen
hClass := __clsInstSuper( ::asSuper[ n ] ) // Super handle available
hClass := __clsInstSuper( ::asSuper[ n ] ) /* Super handle available */
IF hClass != 0
AAdd( ahSuper, hClass )
ENDIF
@@ -231,7 +231,7 @@ STATIC PROCEDURE Create()
//NEXT
////
//Local message...
/* Local message... */
FOR n := 1 TO nLenDatas
__clsAddMsg( hClass, ::aDatas[ n ][ HB_OO_DATA_SYMBOL ] , n, ;
@@ -274,13 +274,13 @@ STATIC PROCEDURE Create()
__clsAddMsg( hClass, "__Destructor", ::nDestructor, HB_OO_MSG_DESTRUCTOR )
ENDIF
//Friend Classes
/* Friend Classes */
nLen := Len( ::asFriendClass )
FOR n := 1 TO nLen
__clsAddFriend( ::hClass, ::asFriendClass[ n ] )
NEXT
//Friend Functions
/* Friend Functions */
nLen := Len( ::asFriendFunc )
FOR n := 1 TO nLen
__clsAddFriend( ::hClass, ::asFriendFunc[ n ] )
@@ -290,11 +290,8 @@ STATIC PROCEDURE Create()
STATIC FUNCTION Instance()
LOCAL Self := QSelf()
LOCAL oInstance := __clsInst( ::hClass )
/*oInstance:Class := Self:Class*/
RETURN oInstance
RETURN __clsInst( ::hClass )
STATIC PROCEDURE AddData( cData, xInit, cType, nScope, lNoinit )
@@ -303,7 +300,7 @@ STATIC PROCEDURE AddData( cData, xInit, cType, nScope, lNoinit )
DEFAULT lNoInit TO .F.
DEFAULT nScope TO HB_OO_CLSTP_EXPORTED
// Default Init for Logical and numeric
/* Default Init for Logical and numeric */
IF ! lNoInit .AND. cType != NIL .AND. xInit == NIL
c := Upper( Left( cType, 1 ) )
IF c == "L" /* Logical */
@@ -325,7 +322,7 @@ STATIC PROCEDURE AddMultiData( cType, xInit, nScope, aData, lNoInit )
LOCAL nParam := Len( aData )
FOR i := 1 TO nParam
IF VALTYPE( aData[ i ] ) == "C"
IF ISCHARACTER( aData[ i ] )
QSelf():AddData( aData[ i ], xInit, cType, nScope, lNoInit )
ENDIF
NEXT
@@ -338,7 +335,7 @@ STATIC PROCEDURE AddClassData( cData, xInit, cType, nScope, lNoInit )
DEFAULT lNoInit TO .F.
// Default Init for Logical and numeric
/* Default Init for Logical and numeric */
IF ! lNoInit .AND. cType != NIL .AND. xInit == NIL
c := Upper( Left( cType, 1 ) )
IF c == "L" /* Logical */
@@ -360,7 +357,7 @@ STATIC PROCEDURE AddMultiClsData( cType, xInit, nScope, aData, lNoInit )
LOCAL nParam := Len( aData )
FOR i := 1 TO nParam
IF VALTYPE( aData[ i ] ) == "C"
IF ISCHARACTER( aData[ i ] )
QSelf():AddClassData( aData[ i ], xInit, cType, nScope, lNoInit )
ENDIF
NEXT
@@ -399,9 +396,9 @@ STATIC PROCEDURE AddDelegate( xMethod, nAccScope, nAsgScope, cType, cDelegMsg, c
LOCAL i
IF VALTYPE( xMethod ) == "C"
IF ISCHARACTER( xMethod )
AAdd( QSelf():aDelegates, { xMethod, nAccScope, nAsgScope, cType, cDelegMsg, cDelegClass } )
ELSEIF VALTYPE( xMethod ) == "A"
ELSEIF ISARRAY( xMethod )
FOR i := 1 TO LEN( xMethod )
AAdd( QSelf():aDelegates, { xMethod[ i ], nAccScope, nAsgScope, cType, cDelegMsg, cDelegClass } )
NEXT

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

@@ -1195,7 +1195,7 @@ METHOD PutMask( xValue, lEdit ) CLASS Get
cChar := SubStr( cPicMask, nFor, 1 )
IF cChar $ ",." .AND. SubStr( cBuffer, nFor, 1 ) $ ",." // " " TOFIX
IF "E" $ cPicFunc
cChar := IIF( cChar == ",", ".", "," )
cChar := iif( cChar == ",", ".", "," )
ENDIF
cBuffer := SubStr( cBuffer, 1, nFor - 1 ) + cChar + SubStr( cBuffer, nFor + 1 )
ENDIF

4
harbour/source/rtl/tgetint.prg
View File

@@ -71,11 +71,11 @@ FUNCTION __GET( bSetGet, cVarName, cPicture, bValid, bWhen )
IF bSetGet == NIL
IF FieldPos( cVarName ) > 0
bSetGet := &( "{|| IIF( PCOUNT()==0, FIELD->" + cVarName + ", FIELD->" + cVarName + " := HB_PVALUE(1) ) }" )
bSetGet := &( "{|| iif( PCount()==0, FIELD->" + cVarName + ", FIELD->" + cVarName + " := hb_PValue(1) ) }" )
ELSEIF __MVEXIST( cVarName )
bSetGet := {|_1| iif( _1 == NIL, __MVGET( cVarName ), __MVPUT( cVarName, _1 ) ) }
ELSE
bSetGet := &( "{|| IIF( PCOUNT()==0, " + cVarName + ", " + cVarName + " := HB_PVALUE(1) ) }" )
bSetGet := &( "{|| iif( PCount()==0, " + cVarName + ", " + cVarName + " := hb_PValue(1) ) }" )
ENDIF
ENDIF

80
harbour/source/rtl/tlabel.prg
View File

@@ -127,7 +127,7 @@ METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ;
LOCAL OldMargin
LOCAL cExt
::aBandToPrint := {} // ARRAY(5)
::aBandToPrint := {} // Array(5)
::nCurrentCol := 1
// Resolve parameters
@@ -153,18 +153,18 @@ METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ;
// Set output devices
IF lPrinter // To the printer
lPrintOn := SET( _SET_PRINTER, lPrinter )
lPrintOn := Set( _SET_PRINTER, lPrinter )
ENDIF
lConsoleOn := SET( _SET_CONSOLE )
SET( _SET_CONSOLE, ! ( lNoConsole .OR. !lConsoleOn ) )
lConsoleOn := Set( _SET_CONSOLE )
Set( _SET_CONSOLE, ! ( lNoConsole .OR. !lConsoleOn ) )
IF !Empty(cAltFile) // To file
lExtraState := SET( _SET_EXTRA, .T. )
cExtraFile := SET( _SET_EXTRAFILE, cAltFile )
lExtraState := Set( _SET_EXTRA, .T. )
cExtraFile := Set( _SET_EXTRAFILE, cAltFile )
ENDIF
OldMargin := SET( _SET_MARGIN, 0)
OldMargin := Set( _SET_MARGIN, 0)
BEGIN SEQUENCE
@@ -190,7 +190,7 @@ METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ;
// Print the last band if there is one
IF ::lOneMoreBand
// Print the band
AEVAL( ::aBandToPrint, { | BandLine | PrintIt( BandLine ) } )
AEval( ::aBandToPrint, { | BandLine | PrintIt( BandLine ) } )
ENDIF
RECOVER USING xBreakVal
@@ -207,19 +207,19 @@ METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ;
::lOneMoreBand :=.T.
// clean up
SET( _SET_PRINTER, lPrintOn ) // Set the printer back to prior state
SET( _SET_CONSOLE, lConsoleOn ) // Set the console back to prior state
Set( _SET_PRINTER, lPrintOn ) // Set the printer back to prior state
Set( _SET_CONSOLE, lConsoleOn ) // Set the console back to prior state
IF !Empty(cAltFile) // Set extrafile back
SET( _SET_EXTRAFILE, cExtraFile )
SET( _SET_EXTRA, lExtraState )
Set( _SET_EXTRAFILE, cExtraFile )
Set( _SET_EXTRA, lExtraState )
ENDIF
IF lBroke
BREAK xBreakVal // continue breaking
ENDIF
SET( _SET_MARGIN, OldMargin )
Set( _SET_MARGIN, OldMargin )
RETURN Self
@@ -268,7 +268,7 @@ METHOD ExecuteLabel() CLASS HBLabelForm
// trim
FOR nField := 1 TO Len( ::aBandToPrint )
::aBandToPrint[ nField ] := Trim( ::aBandToPrint[ nField ] )
::aBandToPrint[ nField ] := RTrim( ::aBandToPrint[ nField ] )
NEXT
@@ -276,7 +276,7 @@ METHOD ExecuteLabel() CLASS HBLabelForm
::nCurrentCol := 1
// Print the band
AEVAL( ::aBandToPrint, { | BandLine | PrintIt( BandLine ) } )
AEval( ::aBandToPrint, { | BandLine | PrintIt( BandLine ) } )
nMoreLines := ::aLabelData[ LBL_HEIGHT ] - Len( ::aBandToPrint )
IF nMoreLines > 0
@@ -318,7 +318,7 @@ METHOD SampleLabels() CLASS HBLabelForm
DO WHILE lMoreSamples
// Print the samples
AEVAL( aBand, { | BandLine | PrintIt( BandLine ) } )
AEval( aBand, { | BandLine | PrintIt( BandLine ) } )
IF ::aLabelData[ LBL_LINES ] > 0
// Add the spaces between the label lines
@@ -328,16 +328,16 @@ METHOD SampleLabels() CLASS HBLabelForm
ENDIF
// Prompt for more
@ ROW(), 0 SAY __NatMsg(_LF_SAMPLES)+" ("+__NatMsg(_LF_YN)+")"
@ Row(), 0 SAY __NatMsg( _LF_SAMPLES ) + " (" + __NatMsg( _LF_YN ) + ")"
nGetKey := Inkey( 0 )
@ ROW(), COL() SAY CHR(nGetKey)
IF ROW() == MAXROW()
SCROLL( 0, 0, MAXROW(), MAXCOL(), 1 )
@ MAXROW(), 0 SAY ""
@ Row(), Col() SAY Chr( nGetKey )
IF Row() == MaxRow()
Scroll( 0, 0, MaxRow(), MaxCol(), 1 )
@ MaxRow(), 0 SAY ""
ELSE
@ ROW()+1, 0 SAY ""
@ Row() + 1, 0 SAY ""
ENDIF
IF __NatIsNegative(CHR(nGetKey)) // Don't give sample labels
IF __NatIsNegative( Chr( nGetKey ) ) // Don't give sample labels
lMoreSamples := .F.
ENDIF
ENDDO
@@ -346,7 +346,7 @@ METHOD SampleLabels() CLASS HBLabelForm
METHOD LoadLabel( cLblFile ) CLASS HBLabelForm
LOCAL i, j := 0 // Counters
LOCAL cBuff := Space(BUFFSIZE) // File buffer
LOCAL cBuff := Space( BUFFSIZE ) // File buffer
LOCAL nHandle := 0 // File handle
LOCAL nReadCount := 0 // Bytes read from file
LOCAL lStatus := .F. // Status
@@ -371,19 +371,19 @@ METHOD LoadLabel( cLblFile ) CLASS HBLabelForm
aLabel[ LBL_FIELDS ] := {} // Array of label fields
// Open the label file
nHandle := FOPEN( cLblFile )
nHandle := FOpen( cLblFile )
IF ! Empty( nFileError := FERROR() ) .AND. !( "\" $ cLblFile .OR. ":" $ cLblFile )
IF ! Empty( nFileError := FError() ) .AND. !( "\" $ cLblFile .OR. ":" $ cLblFile )
// Search through default path; attempt to open label file
cDefPath := SET( _SET_DEFAULT )
cDefPath := STRTRAN( cDefPath, ",", ";" )
cDefPath := Set( _SET_DEFAULT )
cDefPath := StrTran( cDefPath, ",", ";" )
aPaths := ListAsArray( cDefPath, ";" )
FOR nPathIndex := 1 TO Len( aPaths )
nHandle := FOPEN( aPaths[ nPathIndex ] + "\" + cLblFile )
nHandle := FOpen( aPaths[ nPathIndex ] + "\" + cLblFile )
// if no error is reported, we have our label file
IF Empty( nFileError := FERROR() )
IF Empty( nFileError := FError() )
EXIT
ENDIF
@@ -405,13 +405,13 @@ METHOD LoadLabel( cLblFile ) CLASS HBLabelForm
// 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 )
nReadCount := FRead( nHandle, @cBuff, BUFFSIZE )
// READ ok?
IF nReadCount == 0
nFileError := F_EMPTY // File is empty
ELSE
nFileError := FERROR() // Check for DOS errors
nFileError := FError() // Check for DOS errors
ENDIF
IF nFileError == 0
@@ -428,7 +428,7 @@ METHOD LoadLabel( cLblFile ) CLASS HBLabelForm
FOR i := 1 TO aLabel[ LBL_HEIGHT ]
// Get the text of the expression
cFieldText := TRIM( SubStr( cBuff, nOffset, FIELDSIZE ) )
cFieldText := RTrim( SubStr( cBuff, nOffset, FIELDSIZE ) )
nOffset :=nOffSet + 60
IF !Empty( cFieldText )
@@ -453,9 +453,9 @@ METHOD LoadLabel( cLblFile ) CLASS HBLabelForm
NEXT
// Close file
FCLOSE( nHandle )
FClose( nHandle )
nFileError := FERROR()
nFileError := FError()
ENDIF
@@ -471,8 +471,8 @@ STATIC PROCEDURE PrintIt( cString )
DEFAULT cString TO ""
QQOUT( cString )
QOUT()
QQOut( cString )
QOut()
RETURN
@@ -486,7 +486,7 @@ STATIC FUNCTION ListAsArray( cList, cDelimiter )
DO WHILE Len( cList ) != 0
nPos := AT( cDelimiter, cList )
nPos := At( cDelimiter, cList )
IF nPos == 0
nPos := Len( cList )
@@ -494,10 +494,10 @@ STATIC FUNCTION ListAsArray( cList, cDelimiter )
IF SubStr( cList, nPos, 1 ) == cDelimiter
lDelimLast := .T.
AAdd(aList, SubStr( cList, 1, nPos - 1 ) ) // Add a new element
AAdd( aList, SubStr( cList, 1, nPos - 1 ) ) // Add a new element
ELSE
lDelimLast := .F.
AAdd(aList, SubStr( cList, 1, nPos ) ) // Add a new element
AAdd( aList, SubStr( cList, 1, nPos ) ) // Add a new element
ENDIF
cList := SubStr( cList, nPos + 1 )

2
harbour/source/rtl/tobject.prg
View File

@@ -102,7 +102,7 @@ FUNCTION HBObject()
s_oClass:SetOnError( @HBObject_DftonError() )
s_oClass:AddInline( "MSGNOTFOUND" , {| Self, cMsg | ::Error( "Message not found", Self:className, cMsg, IIF( Left( cMsg, 1 ) == "_", 1005, 1004 ) ) }, HB_OO_CLSTP_EXPORTED )
s_oClass:AddInline( "MSGNOTFOUND" , {| Self, cMsg | ::Error( "Message not found", Self:className, cMsg, iif( Left( cMsg, 1 ) == "_", 1005, 1004 ) ) }, HB_OO_CLSTP_EXPORTED )
/*s_oClass:AddMultiData( , , HB_OO_CLSTP_EXPORTED, { "CLASS" }, .F. ) */

104
harbour/source/rtl/persist.prg → harbour/source/rtl/tpersist.prg
View File

@@ -76,7 +76,7 @@ METHOD LoadFromText( cObjectText ) CLASS HBPersistent
RETURN .F.
ENDIF
// We skip the first empty lines
/* We skip the first empty lines */
DO WHILE Empty( ExtractLine( cObjectText, @nFrom ) )
ENDDO
@@ -85,23 +85,23 @@ METHOD LoadFromText( cObjectText ) CLASS HBPersistent
DO CASE
CASE Upper( LTrim( hb_TokenGet( cLine, 1 ) ) ) == "OBJECT"
IF lStart
lStart := .F.
ENDIF
IF lStart
lStart := .F.
ENDIF
CASE Upper( LTrim( hb_TokenGet( cLine, 1 ) ) ) == "ARRAY"
cLine := SubStr( cLine, At( "::", cLine ) )
M->oSelf := Self
cLine := StrTran( cLine, "::", "oSelf:" )
cLine := StrTran( cLine, " LEN ", " = Array( " )
cLine := RTrim( StrTran( cLine, "=", ":=", , 1 ) ) + " )"
cLine := &( cLine )
cLine := SubStr( cLine, At( "::", cLine ) )
MEMVAR->oSelf := Self
cLine := StrTran( cLine, "::", "oSelf:" )
cLine := StrTran( cLine, " LEN ", " = Array( " )
cLine := RTrim( StrTran( cLine, "=", ":=", , 1 ) ) + " )"
cLine := &( cLine )
CASE Left( cToken := LTrim( hb_TokenGet( cLine, 1, "=" ) ), 2 ) == "::"
M->oSelf := Self
cLine := StrTran( cLine, "::", "oSelf:" )
cLine := StrTran( cLine, "=", ":=", , 1 )
cLine := &( cLine )
MEMVAR->oSelf := Self
cLine := StrTran( cLine, "::", "oSelf:" )
cLine := StrTran( cLine, "=", ":=", , 1 )
cLine := &( cLine )
ENDCASE
@@ -142,28 +142,28 @@ METHOD SaveToText( cObjectName, nIndent ) CLASS HBPersistent
DO CASE
CASE cType == "A"
nIndent += 3
cObject += ArrayToText( uValue, aProperties[ n ], nIndent )
nIndent -= 3
IF n < Len( aProperties )
cObject += hb_OSNewLine()
ENDIF
nIndent += 3
cObject += ArrayToText( uValue, aProperties[ n ], nIndent )
nIndent -= 3
IF n < Len( aProperties )
cObject += hb_OSNewLine()
ENDIF
CASE cType == "O"
IF __objDerivedFrom( uValue, "HBPERSISTENT" )
cObject += uValue:SaveToText( aProperties[ n ], nIndent )
ENDIF
IF n < Len( aProperties )
cObject += hb_OSNewLine()
ENDIF
IF __objDerivedFrom( uValue, "HBPERSISTENT" )
cObject += uValue:SaveToText( aProperties[ n ], nIndent )
ENDIF
IF n < Len( aProperties )
cObject += hb_OSNewLine()
ENDIF
OTHERWISE
IF n == 1
cObject += hb_OSNewLine()
ENDIF
cObject += Space( nIndent ) + " ::" + ;
aProperties[ n ] + " = " + ValToText( uValue ) + ;
hb_OSNewLine()
IF n == 1
cObject += hb_OSNewLine()
ENDIF
cObject += Space( nIndent ) + " ::" + ;
aProperties[ n ] + " = " + ValToText( uValue ) + ;
hb_OSNewLine()
ENDCASE
ENDIF
@@ -188,24 +188,24 @@ STATIC FUNCTION ArrayToText( aArray, cName, nIndent )
DO CASE
CASE cType == "A"
nIndent += 3
cArray += ArrayToText( uValue, cName + "[ " + ;
AllTrim( Str( n ) ) + " ]", nIndent ) + hb_OSNewLine()
nIndent -= 3
nIndent += 3
cArray += ArrayToText( uValue, cName + "[ " + ;
AllTrim( Str( n ) ) + " ]", nIndent ) + hb_OSNewLine()
nIndent -= 3
CASE cType == "O"
IF __objDerivedFrom( uValue, "HBPERSISTENT" )
cArray += uValue:SaveToText( cName + "[ " + AllTrim( Str( n ) ) + ;
" ]", nIndent )
ENDIF
IF __objDerivedFrom( uValue, "HBPERSISTENT" )
cArray += uValue:SaveToText( cName + "[ " + AllTrim( Str( n ) ) + ;
" ]", nIndent )
ENDIF
OTHERWISE
IF n == 1
cArray += hb_OSNewLine()
ENDIF
cArray += Space( nIndent ) + " ::" + cName + ;
+ "[ " + AllTrim( Str( n ) ) + " ]" + " = " + ;
ValToText( uValue ) + hb_OSNewLine()
IF n == 1
cArray += hb_OSNewLine()
ENDIF
cArray += Space( nIndent ) + " ::" + cName + ;
+ "[ " + AllTrim( Str( n ) ) + " ]" + " = " + ;
ValToText( uValue ) + hb_OSNewLine()
ENDCASE
NEXT
@@ -220,22 +220,22 @@ STATIC FUNCTION ValToText( uValue )
DO CASE
CASE cType == "C"
cText := hb_StrToExp( uValue )
cText := hb_StrToExp( uValue )
CASE cType == "N"
cText := AllTrim( Str( uValue ) )
cText := AllTrim( Str( uValue ) )
CASE cType == "D"
cText := DToS( uValue )
cText := "0d" + iif( Empty( cText ), "00000000", cText )
cText := DToS( uValue )
cText := "0d" + iif( Empty( cText ), "00000000", cText )
OTHERWISE
cText := hb_ValToStr( uValue )
cText := hb_ValToStr( uValue )
ENDCASE
RETURN cText
// Notice: nFrom must be supplied by reference
/* Notice: nFrom must be supplied by reference */
STATIC FUNCTION ExtractLine( cText, nFrom )

269
harbour/source/rtl/treport.prg
View File

@@ -226,9 +226,9 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco
// Set output devices
lPrintOn := iif( lPrinter, SET( _SET_PRINTER, lPrinter ), SET( _SET_PRINTER ) )
lPrintOn := iif( lPrinter, Set( _SET_PRINTER, lPrinter ), Set( _SET_PRINTER ) )
lConsoleOn := iif( lNoConsole, SET( _SET_CONSOLE, .F. ), SET( _SET_CONSOLE ) )
lConsoleOn := iif( lNoConsole, Set( _SET_CONSOLE, .F. ), Set( _SET_CONSOLE ) )
IF lPrinter // To the printer
::lFormFeeds := .T.
@@ -237,8 +237,8 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco
ENDIF
IF !Empty(cAltFile) // To file
lExtraState := SET( _SET_EXTRA, .T. )
cExtraFile := SET( _SET_EXTRAFILE, cAltFile )
lExtraState := Set( _SET_EXTRA, .T. )
cExtraFile := Set( _SET_EXTRAFILE, cAltFile )
ENDIF
@@ -264,7 +264,7 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco
// Add to the left margin if a SET MARGIN has been defined
// NOTE: uncommenting this line will cause REPORT FORM to respect
// SET MARGIN to screen/to file, but double the margin TO PRINT
// ::aReportData[ RPT_LMARGIN ] += SET( _SET_MARGIN )
// ::aReportData[ RPT_LMARGIN ] += Set( _SET_MARGIN )
::nPageNumber := 1 // Set the initial page number
::lFirstPass := .T. // Set the first pass flag
@@ -284,7 +284,7 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco
// Initialize ::aReportTotals to track both group and report totals, then
// set the column total elements to 0 if they are to be totaled, otherwise
// leave them NIL
::aReportTotals := ARRAY( Len( ::aReportData[RPT_GROUPS] ) + 1, ;
::aReportTotals := Array( Len( ::aReportData[RPT_GROUPS] ) + 1, ;
Len( ::aReportData[RPT_COLUMNS] ) )
// Column total elements
@@ -297,7 +297,7 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco
NEXT
// Initialize ::aGroupTotals as an array
::aGroupTotals := ARRAY( Len(::aReportData[RPT_GROUPS]) )
::aGroupTotals := Array( Len(::aReportData[RPT_GROUPS]) )
// Execute the actual report based on matching records
DBEval( { || ::ExecuteReport() }, bFor, bWhile, nNext, nRecord, lRest )
@@ -337,21 +337,21 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco
__NatMsg( _RFRM_SUBSUBTOTAL ) ) )
// Print the second line
QQOUT( Space(::aReportData[RPT_LMARGIN]) )
QQOut( Space(::aReportData[RPT_LMARGIN]) )
FOR nCol := 1 TO Len(::aReportData[RPT_COLUMNS])
IF nCol > 1
QQOUT( " " )
QQOut( " " )
ENDIF
IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL]
QQOUT( TRANSFORM(::aReportTotals[nGroup+1,nCol], ;
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
QOUT()
QOut()
NEXT
@@ -381,21 +381,21 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco
::PrintIt( Space(::aReportData[RPT_LMARGIN]) + __NatMsg(_RFRM_TOTAL ) )
// Print the second line
QQOUT( Space(::aReportData[RPT_LMARGIN]) )
QQOut( Space(::aReportData[RPT_LMARGIN]) )
FOR nCol := 1 TO Len(::aReportData[RPT_COLUMNS])
IF nCol > 1
QQOUT( " " )
QQOut( " " )
ENDIF
IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL]
QQOUT( TRANSFORM(::aReportTotals[1,nCol], ;
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 nCol
// Send a cr/lf for the last line
QOUT()
QOut()
ENDIF
@@ -423,12 +423,12 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco
::nMaxLinesAvail := NIL
// clean up
SET( _SET_PRINTER, lPrintOn ) // Set the printer back to prior state
SET( _SET_CONSOLE, lConsoleOn ) // Set the console back to prior state
Set( _SET_PRINTER, lPrintOn ) // Set the printer back to prior state
Set( _SET_CONSOLE, lConsoleOn ) // Set the console back to prior state
IF !Empty(cAltFile) // Set extrafile back
SET( _SET_EXTRAFILE, cExtraFile )
SET( _SET_EXTRA, lExtraState )
Set( _SET_EXTRAFILE, cExtraFile )
Set( _SET_EXTRA, lExtraState )
ENDIF
IF lBroke
@@ -442,8 +442,8 @@ METHOD PrintIt( cString ) CLASS HBReportForm
DEFAULT cString TO ""
QQOUT( cString )
QOUT()
QQOut( cString )
QOut()
RETURN Self
@@ -470,37 +470,37 @@ METHOD ReportHeader() CLASS HBReportForm
IF !::aReportData[RPT_PLAIN]
IF ::aReportData[RPT_HEADING] == ""
AAdd( aPageHeader,__NatMsg(_RFRM_PAGENO) + STR(::nPageNumber,6))
AAdd( aPageHeader,__NatMsg(_RFRM_PAGENO) + Str(::nPageNumber,6))
ELSE
aTempPgHeader:=ParseHeader( ::aReportData[RPT_HEADING],;
Occurs(";",::aReportData[RPT_HEADING]) +1 )
FOR nLine := 1 to Len( aTempPgHeader)
nLinesInHeader:=MAX( XMLCOUNT( LTRIM( aTempPgHeader[ nLine ] ) , ;
nLinesInHeader:=Max( XMLCOUNT( LTrim( aTempPgHeader[ nLine ] ) , ;
nHeadingLength),1)
FOR nHeadLine := 1 to nLinesInHeader
AAdd( aPageHeader, Space( 15 ) + ;
PADC( TRIM( XMEMOLINE( LTRIM( aTempPgHeader[ nLine ]),;
PadC( RTrim( XMEMOLINE( LTrim( aTempPgHeader[ nLine ]),;
nHeadingLength,nHeadLine)), nHeadingLength))
NEXT nHeadLine
NEXT nLine
aPageHeader[ 1 ] := STUFF(aPageHeader[ 1 ], 1, 14, ;
__NatMsg(_RFRM_PAGENO)+STR(::nPageNumber,6))
aPageHeader[ 1 ] := Stuff(aPageHeader[ 1 ], 1, 14, ;
__NatMsg(_RFRM_PAGENO)+Str(::nPageNumber,6))
ENDIF
AAdd( aPageHeader, DTOC(DATE()) )
AAdd( aPageHeader, DToC(Date()) )
ENDIF
FOR nLine := 1 TO Len( ::aReportData[ RPT_HEADER])
nLinesInHeader := MAX( XMLCOUNT(LTRIM( ::aReportData[RPT_HEADER,;
FOR nLine := 1 TO Len( ::aReportData[ RPT_HEADER])
nLinesInHeader := Max( XMLCOUNT(LTrim( ::aReportData[RPT_HEADER,;
nLine ] ), nHeadSize),1 )
FOR nHeadLine := 1 to nLinesInHeader
cHeader:=TRIM( XMEMOLINE( LTRIM( ::aReportData[RPT_HEADER, nLine ]),;
cHeader := RTrim( XMEMOLINE( LTrim( ::aReportData[RPT_HEADER, nLine ]),;
nHeadSize,nHeadLine))
AAdd( aPageHeader, Space((nRPageSize - ::aReportData[ RPT_LMARGIN ] -;
Len( cHeader ) ) / 2 ) + cHeader )
@@ -512,7 +512,7 @@ METHOD ReportHeader() CLASS HBReportForm
nLinesInHeader := Len( aPageHeader)
nMaxColLength :=0
FOR nCol := 1 TO Len( ::aReportData[RPT_COLUMNS] )
nMaxColLength := MAX(Len(::aReportData[RPT_COLUMNS,nCol,RCT_HEADER]), ;
nMaxColLength := Max(Len(::aReportData[RPT_COLUMNS,nCol,RCT_HEADER]), ;
nMaxColLength)
NEXT
FOR nCol := 1 to Len( ::aReportData[RPT_COLUMNS] )
@@ -533,11 +533,11 @@ METHOD ReportHeader() CLASS HBReportForm
ELSE
IF ::aReportData[RPT_COLUMNS,nCol,RCT_TYPE] == "N"
aPageHeader[ nLinesInHeader + nLine ] += ;
PADL(::aReportData[RPT_COLUMNS,nCol,RCT_HEADER,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],;
PadR(::aReportData[RPT_COLUMNS,nCol,RCT_HEADER,nLine],;
::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH])
ENDIF
ENDIF
@@ -547,7 +547,7 @@ METHOD ReportHeader() CLASS HBReportForm
// Insert the two blank lines between the heading and the actual data
AAdd( aPageHeader, "" )
AAdd( aPageHeader, "" )
AEVAL( aPageHeader, { | HeaderLine | ;
AEval( aPageHeader, { | HeaderLine | ;
::PrintIt( Space(::aReportData[RPT_LMARGIN])+ HeaderLine ) } )
// Set the page number and number of available lines
@@ -578,7 +578,7 @@ METHOD ExecuteReport() CLASS HBReportForm
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] )
Eval( ::aReportData[RPT_COLUMNS,nCol,RCT_EXP] )
ENDIF
NEXT
@@ -609,13 +609,13 @@ METHOD ExecuteReport() CLASS HBReportForm
ENDIF
// For subgroup processing: check if group has been changed
IF MakeAStr(EVAL(::aReportData[RPT_GROUPS, 1, RGT_EXP]),;
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]),;
IF lGroupChanged .OR. MakeAStr(Eval(::aReportData[RPT_GROUPS,nGroup,RGT_EXP]),;
::aReportData[RPT_GROUPS,nGroup,RGT_TYPE]) != ::aGroupTotals[nGroup]
AAdd( aRecordHeader, iif( nGroup == 1, __NatMsg(_RFRM_SUBTOTAL),;
@@ -629,7 +629,7 @@ METHOD ExecuteReport() CLASS HBReportForm
FOR nCol := 1 TO Len(::aReportData[RPT_COLUMNS])
IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL]
aRecordHeader[ Len(aRecordHeader) ] += ;
TRANSFORM(::aReportTotals[nGroup+1,nCol], ;
Transform(::aReportTotals[nGroup+1,nCol], ;
::aReportData[RPT_COLUMNS,nCol,RCT_PICT])
// Zero out the group totals column from aReportTotals
::aReportTotals[nGroup+1,nCol] := 0
@@ -661,7 +661,7 @@ METHOD ExecuteReport() CLASS HBReportForm
ENDIF
AEVAL( aRecordHeader, { | HeaderLine | ;
AEval( aRecordHeader, { | HeaderLine | ;
::PrintIt( Space( ::aReportData[ RPT_LMARGIN ] ) + HeaderLine ) } )
aRecordHeader := {}
@@ -684,7 +684,7 @@ 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]),;
IF MakeAStr(Eval(::aReportData[RPT_GROUPS,nGroup,RGT_EXP]),;
::aReportData[RPT_GROUPS,nGroup,RGT_TYPE]) == ::aGroupTotals[nGroup]
ELSE
AAdd( aRecordHeader, "" ) // The blank line
@@ -701,7 +701,7 @@ METHOD ExecuteReport() CLASS HBReportForm
AAdd( aRecordHeader, iif( nGroup == 1, "** ", "* " ) +;
::aReportData[RPT_GROUPS,nGroup,RGT_HEADER] + " " +;
MakeAStr(EVAL(::aReportData[RPT_GROUPS,nGroup,RGT_EXP]), ;
MakeAStr(Eval(::aReportData[RPT_GROUPS,nGroup,RGT_EXP]), ;
::aReportData[RPT_GROUPS,nGroup,RGT_TYPE]) )
ENDIF
NEXT
@@ -722,7 +722,7 @@ METHOD ExecuteReport() CLASS HBReportForm
ENDIF
// Send aRecordHeader to the output device, resetting nLinesLeft
AEVAL( aRecordHeader, { | HeaderLine | ;
AEval( aRecordHeader, { | HeaderLine | ;
::PrintIt( Space(::aReportData[RPT_LMARGIN])+ HeaderLine ) } )
::nLinesLeft -= Len( aRecordHeader )
@@ -745,14 +745,14 @@ METHOD ExecuteReport() CLASS HBReportForm
// Cycle through the groups
FOR nGroup := 1 TO Len( ::aReportTotals ) - 1
::aReportTotals[nGroup+1,nCol] += ;
EVAL( ::aReportData[RPT_COLUMNS,nCol,RCT_EXP] )
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]),;
::aGroupTotals[nGroup] := MakeAStr(Eval(::aReportData[RPT_GROUPS,nGroup,RGT_EXP]),;
::aReportData[RPT_GROUPS,nGroup,RGT_TYPE])
NEXT
@@ -763,11 +763,11 @@ METHOD ExecuteReport() CLASS HBReportForm
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]),;
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]),;
";", CHR(13)+CHR(10)),;
nMaxLines := Max( XMLCOUNT( StrTran( Eval( ::aReportData[RPT_COLUMNS,nCol,RCT_EXP]),;
";", hb_osNewLine() ),;
::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH]), nMaxLines)
ENDIF
NEXT
@@ -785,19 +785,19 @@ METHOD ExecuteReport() CLASS HBReportForm
// 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( TRIM( STRTRAN( EVAL(::aReportData[RPT_COLUMNS,nCol,RCT_EXP]),;
";", CHR(13)+CHR(10)) ),;
::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH], nLine )
cLine := XMEMOLINE( RTrim( StrTran( Eval(::aReportData[RPT_COLUMNS,nCol,RCT_EXP]),;
";", hb_osNewLine() ) ),;
::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ], nLine )
ELSE
cLine := XMEMOLINE(TRIM(EVAL(::aReportData[RPT_COLUMNS,nCol,RCT_EXP])),;
::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH], nLine )
cLine := XMEMOLINE( RTrim( Eval( ::aReportData[ RPT_COLUMNS, nCol, RCT_EXP ] ) ),;
::aReportData[ RPT_COLUMNS, nCol, RCT_WIDTH ], nLine )
ENDIF
cLine := PADR( cLine, ::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH] )
cLine := PadR( cLine, ::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH] )
ELSE
IF nLine == 1
cLine := TRANSFORM(EVAL(::aReportData[RPT_COLUMNS,nCol,RCT_EXP]),;
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 := PadR( cLine, ::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH] )
ELSE
cLine := Space( ::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH])
ENDIF
@@ -837,7 +837,7 @@ METHOD ExecuteReport() CLASS HBReportForm
ELSE
::ReportHeader()
ENDIF
AEVAL( aRecordToPrint, ;
AEval( aRecordToPrint, ;
{ | RecordLine | ;
::PrintIt( Space(::aReportData[RPT_LMARGIN])+ RecordLine ) ;
} ;
@@ -846,7 +846,7 @@ METHOD ExecuteReport() CLASS HBReportForm
ENDIF
ELSE
// Send aRecordToPrint to the output device, resetting ::nLinesLeft
AEVAL( aRecordToPrint, ;
AEval( aRecordToPrint, ;
{ | RecordLine | ;
::PrintIt( Space(::aReportData[RPT_LMARGIN])+ RecordLine ) ;
} ;
@@ -918,21 +918,20 @@ METHOD LoadReportFile( cFrmFile ) CLASS HBReportForm
aReport[ RPT_HEADING ] := ""
// Open the report file
nFrmHandle := FOPEN( cFrmFile )
nFrmHandle := FOpen( cFrmFile )
IF !Empty( nFileError := FERROR() ) .AND. !( "\" $ cFrmFile .OR. ":" $ cFrmFile )
IF !Empty( nFileError := FError() ) .AND. !( "\" $ cFrmFile .OR. ":" $ cFrmFile )
// Search through default path; attempt to open report file
cDefPath := SET( _SET_DEFAULT ) + ";" + SET( _SET_PATH )
cDefPath := STRTRAN( cDefPath, ",", ";" )
cDefPath := Set( _SET_DEFAULT ) + ";" + Set( _SET_PATH )
cDefPath := StrTran( cDefPath, ",", ";" )
aPaths := ListAsArray( cDefPath, ";" )
FOR nPathIndex := 1 TO Len( aPaths )
nFrmHandle := FOPEN( aPaths[ nPathIndex ] + "\" + cFrmFile )
nFrmHandle := FOpen( aPaths[ nPathIndex ] + "\" + cFrmFile )
// if no error is reported, we have our report file
IF Empty( nFileError := FERROR() )
IF Empty( nFileError := FError() )
EXIT
ENDIF
NEXT nPathIndex
@@ -947,34 +946,34 @@ METHOD LoadReportFile( cFrmFile ) CLASS HBReportForm
err:subSystem := "FRMLBL"
err:osCode := nFileError
err:filename := cFrmFile
Eval(ErrorBlock(), err)
Eval( ErrorBlock(), err )
ENDIF
// OPEN ok?
IF nFileError == F_OK
// Go to START of report file
FSEEK(nFrmHandle, 0)
FSeek( nFrmHandle, 0 )
// SEEK ok?
nFileError := FERROR()
nFileError := FError()
IF nFileError == F_OK
// Read entire file into process buffer
nBytesRead := FREAD(nFrmHandle, @cFileBuff, SIZE_FILE_BUFF)
nBytesRead := FRead( nFrmHandle, @cFileBuff, SIZE_FILE_BUFF )
// READ ok?
IF nBytesRead == 0
nFileError := F_EMPTY // file is empty
ELSE
nFileError := FERROR() // check for DOS errors
nFileError := FError() // check for DOS errors
ENDIF
IF nFileError == F_OK
// Is this a .FRM type file (2 at start and end of file)
IF BIN2W(SubStr(cFileBuff, 1, 2)) == 2 .AND.;
BIN2W(SubStr(cFileBuff, SIZE_FILE_BUFF - 1, 2)) == 2
// Is this a .frm type file (2 at start and end of file)
IF BIN2W( SubStr( cFileBuff, 1, 2 ) ) == 2 .AND.;
BIN2W( SubStr( cFileBuff, SIZE_FILE_BUFF - 1, 2 ) ) == 2
nFileError := F_OK
ELSE
@@ -986,75 +985,75 @@ METHOD LoadReportFile( cFrmFile ) CLASS HBReportForm
ENDIF
// Close file
IF !FCLOSE(nFrmHandle)
nFileError := FERROR()
IF !FClose( nFrmHandle )
nFileError := FError()
ENDIF
ENDIF
// File existed, was opened and read ok and is a .FRM file
// File existed, was opened and read ok and is a .frm file
IF nFileError == F_OK
// Fill processing buffers
::cLengthsBuff := SubStr(cFileBuff, LENGTHS_OFFSET, SIZE_LENGTHS_BUFF)
::cOffSetsBuff := SubStr(cFileBuff, OFFSETS_OFFSET, SIZE_OFFSETS_BUFF)
::cExprBuff := SubStr(cFileBuff, EXPR_OFFSET, SIZE_EXPR_BUFF)
cFieldsBuff := SubStr(cFileBuff, FIELDS_OFFSET, SIZE_FIELDS_BUFF)
cParamsBuff := SubStr(cFileBuff, PARAMS_OFFSET, SIZE_PARAMS_BUFF)
::cLengthsBuff := SubStr( cFileBuff, LENGTHS_OFFSET, SIZE_LENGTHS_BUFF )
::cOffSetsBuff := SubStr( cFileBuff, OFFSETS_OFFSET, SIZE_OFFSETS_BUFF )
::cExprBuff := SubStr( cFileBuff, EXPR_OFFSET, SIZE_EXPR_BUFF )
cFieldsBuff := SubStr( cFileBuff, FIELDS_OFFSET, SIZE_FIELDS_BUFF )
cParamsBuff := SubStr( cFileBuff, PARAMS_OFFSET, SIZE_PARAMS_BUFF )
// Process report attributes
// Report width
aReport[ RPT_WIDTH ] := BIN2W(SubStr(cParamsBuff, PAGE_WIDTH_OFFSET, 2))
aReport[ RPT_WIDTH ] := BIN2W( SubStr( cParamsBuff, PAGE_WIDTH_OFFSET, 2 ) )
// Lines per page
aReport[ RPT_LINES ] := BIN2W(SubStr(cParamsBuff, LNS_PER_PAGE_OFFSET, 2))
aReport[ RPT_LINES ] := BIN2W( SubStr( cParamsBuff, LNS_PER_PAGE_OFFSET, 2 ) )
// Page offset (left margin)
aReport[ RPT_LMARGIN ] := BIN2W(SubStr(cParamsBuff, LEFT_MRGN_OFFSET, 2))
aReport[ RPT_LMARGIN ] := BIN2W( SubStr( cParamsBuff, LEFT_MRGN_OFFSET, 2 ) )
// Page right margin (not used)
aReport[ RPT_RMARGIN ] := BIN2W(SubStr(cParamsBuff, RIGHT_MGRN_OFFSET, 2))
aReport[ RPT_RMARGIN ] := BIN2W( SubStr( cParamsBuff, RIGHT_MGRN_OFFSET, 2 ) )
nColCount := BIN2W(SubStr(cParamsBuff, COL_COUNT_OFFSET, 2))
// Line spacing
// Spacing is 1, 2, or 3
aReport[ RPT_SPACING ] := iif( SubStr( cParamsBuff, ;
DBL_SPACE_OFFSET, 1) $ "YyTt", 2, 1)
DBL_SPACE_OFFSET, 1 ) $ "YyTt", 2, 1 )
// Summary report flag
aReport[ RPT_SUMMARY ] := iif( SubStr( cParamsBuff, ;
SUMMARY_RPT_OFFSET, 1) $ "YyTt", .T., .F.)
SUMMARY_RPT_OFFSET, 1 ) $ "YyTt", .T., .F. )
// Process report eject and plain attributes option byte
cOptionByte := ASC(SubStr(cParamsBuff, OPTION_OFFSET, 1))
cOptionByte := Asc( SubStr( cParamsBuff, OPTION_OFFSET, 1 ) )
IF INT(cOptionByte / 4) == 1
IF Int( cOptionByte / 4 ) == 1
aReport[ RPT_PLAIN ] := .T. // Plain page
cOptionByte -= 4
ENDIF
IF INT(cOptionByte / 2) == 1
IF Int( cOptionByte / 2 ) == 1
aReport[ RPT_AEJECT ] := .T. // Page eject after report
cOptionByte -= 2
ENDIF
IF INT(cOptionByte / 1) == 1
IF Int( cOptionByte / 1 ) == 1
aReport[ RPT_BEJECT ] := .F. // Page eject before report
cOptionByte -= 1
ENDIF
// Page heading, report title
nPointer := BIN2W(SubStr(cParamsBuff, PAGE_HDR_OFFSET, 2))
nPointer := BIN2W( SubStr( cParamsBuff, PAGE_HDR_OFFSET, 2 ) )
// Retrieve the header stored in the .FRM file
// 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
// certain that we have retrieved all heading entries from the .frm file, we
// now retract the empty headings
DO WHILE ( nHeaderIndex > 0 )
DO WHILE nHeaderIndex > 0
IF ! Empty( aHeader[ nHeaderIndex ] )
EXIT
ENDIF
@@ -1066,53 +1065,53 @@ METHOD LoadReportFile( cFrmFile ) CLASS HBReportForm
// Process Groups
// Group
nPointer := BIN2W(SubStr(cParamsBuff, GRP_EXPR_OFFSET, 2))
nPointer := BIN2W( SubStr( cParamsBuff, GRP_EXPR_OFFSET, 2 ) )
IF !Empty(cGroupExp := ::GetExpr( nPointer ))
IF !Empty( cGroupExp := ::GetExpr( nPointer ) )
// Add a new group array
AAdd( aReport[ RPT_GROUPS ], ARRAY( RGT_COUNT ))
AAdd( aReport[ RPT_GROUPS ], Array( RGT_COUNT ) )
// Group expression
aReport[ RPT_GROUPS ][1][ RGT_TEXT ] := cGroupExp
aReport[ RPT_GROUPS ][1][ RGT_EXP ] := &( "{ || " + cGroupExp + "}" )
IF USED()
aReport[ RPT_GROUPS ][1][ RGT_TYPE ] := ;
VALTYPE( EVAL( aReport[ RPT_GROUPS ][1][ RGT_EXP ] ) )
aReport[ RPT_GROUPS ][ 1 ][ RGT_TEXT ] := cGroupExp
aReport[ RPT_GROUPS ][ 1 ][ RGT_EXP ] := &( "{ || " + cGroupExp + "}" )
IF Used()
aReport[ RPT_GROUPS ][ 1 ][ RGT_TYPE ] := ;
ValType( Eval( aReport[ RPT_GROUPS ][ 1 ][ RGT_EXP ] ) )
ENDIF
// Group header
nPointer := BIN2W(SubStr(cParamsBuff, GRP_HDR_OFFSET, 2))
aReport[ RPT_GROUPS ][1][ RGT_HEADER ] := ::GetExpr( nPointer )
nPointer := BIN2W( SubStr( cParamsBuff, GRP_HDR_OFFSET, 2 ) )
aReport[ RPT_GROUPS ][ 1 ][ RGT_HEADER ] := ::GetExpr( nPointer )
// Page eject after group
aReport[ RPT_GROUPS ][1][ RGT_AEJECT ] := iif( SubStr( cParamsBuff, ;
PE_OFFSET, 1) $ "YyTt", .T., .F.)
aReport[ RPT_GROUPS ][ 1 ][ RGT_AEJECT ] := iif( SubStr( cParamsBuff, ;
PE_OFFSET, 1) $ "YyTt", .T., .F. )
ENDIF
// Subgroup
nPointer := BIN2W(SubStr(cParamsBuff, SUB_EXPR_OFFSET, 2))
nPointer := BIN2W( SubStr( cParamsBuff, SUB_EXPR_OFFSET, 2 ) )
IF !Empty(cSubGroupExp := ::GetExpr( nPointer ))
IF !Empty( cSubGroupExp := ::GetExpr( nPointer ) )
// Add new group array
AAdd( aReport[ RPT_GROUPS ], ARRAY( RGT_COUNT ))
AAdd( aReport[ RPT_GROUPS ], Array( RGT_COUNT ) )
// Subgroup expression
aReport[ RPT_GROUPS ][2][ RGT_TEXT ] := cSubGroupExp
aReport[ RPT_GROUPS ][2][ RGT_EXP ] := &( "{ || " + cSubGroupExp + "}" )
IF USED()
aReport[ RPT_GROUPS ][2][ RGT_TYPE ] := ;
VALTYPE( EVAL( aReport[ RPT_GROUPS ][2][ RGT_EXP ] ) )
aReport[ RPT_GROUPS ][ 2 ][ RGT_TEXT ] := cSubGroupExp
aReport[ RPT_GROUPS ][ 2 ][ RGT_EXP ] := &( "{ || " + cSubGroupExp + "}" )
IF Used()
aReport[ RPT_GROUPS ][ 2 ][ RGT_TYPE ] := ;
ValType( Eval( aReport[ RPT_GROUPS ][ 2 ][ RGT_EXP ] ) )
ENDIF
// Subgroup header
nPointer := BIN2W(SubStr(cParamsBuff, SUB_HDR_OFFSET, 2))
aReport[ RPT_GROUPS ][2][ RGT_HEADER ] := ::GetExpr( nPointer )
nPointer := BIN2W( SubStr( cParamsBuff, SUB_HDR_OFFSET, 2 ) )
aReport[ RPT_GROUPS ][ 2 ][ RGT_HEADER ] := ::GetExpr( nPointer )
// Page eject after subgroup
aReport[ RPT_GROUPS ][2][ RGT_AEJECT ] := .F.
aReport[ RPT_GROUPS ][ 2 ][ RGT_AEJECT ] := .F.
ENDIF
@@ -1139,7 +1138,7 @@ METHOD LoadReportFile( cFrmFile ) 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)
* b. Character following character pointed to by pointer is Chr(0)
*
*/
@@ -1157,11 +1156,11 @@ METHOD GetExpr( nPointer ) CLASS HBReportForm
// Calculate offset into OFFSETS_BUFF
IF nPointer > 1
nOffsetOffset := (nPointer * 2) - 1
nOffsetOffset := ( nPointer * 2 ) - 1
ENDIF
nExprOffset := BIN2W(SubStr(::cOffsetsBuff, nOffsetOffset, 2))
nExprLength := BIN2W(SubStr(::cLengthsBuff, nOffsetOffset, 2))
nExprOffset := BIN2W( SubStr( ::cOffsetsBuff, nOffsetOffset, 2 ) )
nExprLength := BIN2W( SubStr( ::cLengthsBuff, nOffsetOffset, 2 ) )
// EXPR_OFFSET points to a NULL, so add one (+1) to get the string
// and subtract one (-1) from EXPR_LENGTH for correct length
@@ -1170,11 +1169,11 @@ METHOD GetExpr( nPointer ) CLASS HBReportForm
nExprLength--
// Extract string
cString := SubStr(::cExprBuff, nExprOffset, nExprLength)
cString := SubStr( ::cExprBuff, nExprOffset, nExprLength )
// dBASE does this so we must do it too
// Character following character pointed to by pointer is NULL
IF CHR(0) == SubStr(cString, 1, 1) .AND. Len(SubStr(cString,1,1)) == 1
IF Chr( 0 ) == SubStr( cString, 1, 1 ) .AND. Len( SubStr( cString, 1, 1 ) ) == 1
cString := ""
ENDIF
ENDIF
@@ -1185,7 +1184,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
@@ -1206,7 +1205,7 @@ STATIC FUNCTION XMLCOUNT( cString, nLineLength, nTabSize, lWrap )
nTabSize := nLineLength - 1
ENDIF
RETURN MLCOUNT( TRIM(cString), nLineLength, nTabSize, lWrap )
RETURN MLCount( RTrim( cString ), nLineLength, nTabSize, lWrap )
/***
*
@@ -1225,7 +1224,7 @@ STATIC FUNCTION XMEMOLINE( cString, nLineLength, nLineNumber, nTabSize, lWrap )
nTabSize := nLineLength - 1
ENDIF
RETURN MEMOLINE( cString, nLineLength, nLineNumber, nTabSize, lWrap )
RETURN MemoLine( cString, nLineLength, nLineNumber, nTabSize, lWrap )
STATIC FUNCTION ParseHeader( cHeaderString, nFields )
LOCAL cItem
@@ -1239,7 +1238,7 @@ STATIC FUNCTION ParseHeader( cHeaderString, nFields )
cItem := SubStr( cHeaderString, 1, nHeaderLen )
// check for explicit delimiter
nPos := AT( ";", cItem )
nPos := At( ";", cItem )
IF ! Empty( nPos )
// delimiter present
@@ -1272,7 +1271,7 @@ STATIC FUNCTION ParseHeader( cHeaderString, nFields )
* Notes:
* 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)
* b. Character following character pointed to by pointer is Chr(0)
*
*/
METHOD GetColumn( cFieldsBuffer, nOffset ) CLASS HBReportForm
@@ -1308,8 +1307,8 @@ METHOD GetColumn( cFieldsBuffer, nOffset ) CLASS HBReportForm
// Column picture
// Setup picture only if a database file is open
IF USED()
cType := VALTYPE( EVAL( aColumn[ RCT_EXP ] ) )
IF Used()
cType := ValType( Eval( aColumn[ RCT_EXP ] ) )
aColumn[ RCT_TYPE ] := cType
DO CASE
CASE cType == "C" .OR. cType == "M"
@@ -1349,7 +1348,7 @@ STATIC FUNCTION ListAsArray( cList, cDelimiter )
DO WHILE Len( cList ) != 0
nPos := AT( cDelimiter, cList )
nPos := At( cDelimiter, cList )
IF nPos == 0
nPos := Len( cList )
@@ -1378,11 +1377,11 @@ STATIC FUNCTION MakeAStr( uVar, cType )
DO CASE
CASE Upper( cType ) == "D"
cString := DTOC( uVar )
cString := DToC( uVar )
CASE Upper( cType ) == "L"
cString := iif( uVar, "T", "F" )
CASE Upper( cType ) == "N"
cString := STR( uVar )
cString := Str( uVar )
CASE Upper( cType ) == "C"
cString := uVar
OTHERWISE

0
harbour/source/rtl/symbol.prg → harbour/source/rtl/tsymbol.prg
View File

14
harbour/source/rtl/typefile.prg
View File

@@ -96,7 +96,7 @@ PROCEDURE __TypeFile( cFile, lPrint )
ENDIF
nRetries := 0
DO WHILE ( nHandle := FOPEN( cFile, FO_READWRITE ) ) == F_ERROR
DO WHILE ( nHandle := FOpen( cFile, FO_READWRITE ) ) == F_ERROR
oErr := ErrorNew()
oErr:severity := ES_ERROR
oErr:genCode := EG_OPEN
@@ -105,7 +105,7 @@ PROCEDURE __TypeFile( cFile, lPrint )
oErr:Description := "Open Error: " + cFile
oErr:canDefault := .T.
oErr:canRetry := .T.
oErr:OsCode := FERROR()
oErr:OsCode := FError()
oErr:tries := ++nRetries
xRecover := Eval( ErrorBlock(), oErr )
IF ISLOGICAL( xRecover ) .AND. !xRecover // user select "Default"
@@ -122,22 +122,22 @@ PROCEDURE __TypeFile( cFile, lPrint )
ENDIF
nSize := FSeek( nHandle, 0, FS_END )
nBuffer := MIN( nSize, BUFFER_LENGTH )
nBuffer := Min( nSize, BUFFER_LENGTH )
FSeek( nHandle, 0 ) // go top
// here we try to read a line at a time but I think we could just
// display the whole buffer since it said: "without any headings or formating"
cbuffer := SPACE( nBuffer )
cbuffer := Space( nBuffer )
? // start in a new line
DO WHILE ( nRead := fread( nHandle, @cbuffer, nBuffer )) > 0
nHasRead += nRead
?? cBuffer
nBuffer := MIN( nSize - nHasRead, nBuffer )
cbuffer := SPACE( nBuffer )
nBuffer := Min( nSize - nHasRead, nBuffer )
cbuffer := Space( nBuffer )
ENDDO
FCLOSE( nHandle )
FClose( nHandle )
IF lPrint
Set( _SET_DEVICE, aSaveSet[ 1 ] )

32
harbour/source/rtl/valtoexp.prg
View File

@@ -52,21 +52,21 @@
FUNCTION hb_VALTOEXP( xVal )
LOCAL cVal
LOCAL v := VALTYPE( xVal )
LOCAL v := ValType( xVal )
SWITCH v
CASE "C"
CASE "M"
cVal := HB_STRTOEXP( xVal )
cVal := hb_StrToExp( xVal )
EXIT
CASE "N"
cVal := LTRIM( STR( xVal ) )
cVal := LTrim( Str( xVal ) )
EXIT
CASE "D"
cVal := IIF( EMPTY( xVal ), "0d00000000", "0d" + DTOS( xVal ) )
cVal := iif( Empty( xVal ), "0d00000000", "0d" + DToS( xVal ) )
EXIT
CASE "L"
cVal := IIF( xVal, ".T.", ".F." )
cVal := iif( xVal, ".T.", ".F." )
EXIT
CASE "S"
cVal := "@" + xVal:name + "()"
@@ -75,18 +75,18 @@ FUNCTION hb_VALTOEXP( xVal )
CASE "O"
cVal := "{"
FOR EACH v IN xVal
cVal += IIF( v:__enumIndex() == 1, "", ", " ) + HB_VALTOEXP( v )
cVal += iif( v:__enumIndex() == 1, "", ", " ) + hb_ValToExp( v )
NEXT
cVal += "}"
EXIT
CASE "H"
IF EMPTY( xVal )
IF Empty( xVal )
cVal := "{=>}"
ELSE
cVal := "{"
FOR EACH v IN xVal
cVal += IIF( v:__enumIndex() == 1, "", ", " ) + ;
HB_VALTOEXP( v:__enumKey() ) + "=>" + HB_VALTOEXP( v )
cVal += iif( v:__enumIndex() == 1, "", ", " ) + ;
hb_ValToExp( v:__enumKey() ) + "=>" + hb_ValToExp( v )
NEXT
cVal += "}"
ENDIF
@@ -107,19 +107,19 @@ FUNCTION hb_VALTOEXP( xVal )
RETURN cVal
FUNCTION hb_CSTR( xVal )
LOCAL v := VALTYPE( xVal )
FUNCTION hb_CStr( xVal )
LOCAL v := ValType( xVal )
SWITCH v
CASE "C"
CASE "M"
RETURN xVal
CASE "N"
RETURN STR( xVal )
RETURN Str( xVal )
CASE "D"
RETURN IIF( EMPTY( xVal ), "0d00000000", "0d" + DTOS( xVal ) )
RETURN iif( Empty( xVal ), "0d00000000", "0d" + DToS( xVal ) )
CASE "L"
RETURN IIF( xVal, ".T.", ".F." )
RETURN iif( xVal, ".T.", ".F." )
CASE "S"
RETURN "@" + xVal:name + "()"
CASE "B"
@@ -127,9 +127,9 @@ FUNCTION hb_CSTR( xVal )
CASE "O"
RETURN "{ " + xVal:className + " Object }"
CASE "A"
RETURN "{ Array of " + LTRIM( STR( LEN( xVal ) ) ) + " Items }"
RETURN "{ Array of " + LTrim( Str( Len( xVal ) ) ) + " Items }"
CASE "H"
RETURN "{ Hash of " + LTRIM( STR( LEN( xVal ) ) ) + " Items }"
RETURN "{ Hash of " + LTrim( Str( Len( xVal ) ) ) + " Items }"
CASE "P"
RETURN "<pointer>"
OTHERWISE