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

2012-09-26 13:29 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
* contrib/hbnf/aavg.prg
  * contrib/hbnf/adessort.prg
  * contrib/hbnf/aeminlen.prg
  * contrib/hbnf/amedian.prg
  * contrib/hbnf/anomatch.prg
  * contrib/hbnf/any2any.prg
  * contrib/hbnf/asum.prg
  * contrib/hbnf/clrsel.prg
  * contrib/hbnf/d2e.prg
  * contrib/hbnf/datecnfg.prg
  * contrib/hbnf/dispmsg.prg
  * contrib/hbnf/findith.prg
  * contrib/hbnf/ftround.prg
  * contrib/hbnf/gcd.prg
  * contrib/hbnf/hex2dec.prg
  * contrib/hbnf/linked.prg
  * contrib/hbnf/menu1.prg
  * contrib/hbnf/menutonf.prg
  * contrib/hbnf/metaph.prg
  * contrib/hbnf/netpv.prg
  * contrib/hbnf/nooccur.prg
  * contrib/hbnf/ntow.prg
  * contrib/hbnf/pchr.prg
  * contrib/hbnf/pegs.prg
  * contrib/hbnf/popadder.prg
  * contrib/hbnf/prtesc.prg
  * contrib/hbnf/pvid.prg
  * contrib/hbnf/savearr.prg
  * contrib/hbnf/scregion.prg
  * contrib/hbnf/sqzn.prg
  * contrib/hbnf/tempfile.prg
  * contrib/hbnf/vertmenu.prg
    * manual formatting
    ! fixed few places where HB_UTF8TOSTR() call was missing
This commit is contained in:
Viktor Szakats
2012-09-26 11:36:15 +00:00
parent 95abd11330
commit 87dca087d1
33 changed files with 330 additions and 286 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
harbour/ChangeLog
View File

@@ -16,6 +16,42 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-09-26 13:29 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbnf/aavg.prg
* contrib/hbnf/adessort.prg
* contrib/hbnf/aeminlen.prg
* contrib/hbnf/amedian.prg
* contrib/hbnf/anomatch.prg
* contrib/hbnf/any2any.prg
* contrib/hbnf/asum.prg
* contrib/hbnf/clrsel.prg
* contrib/hbnf/d2e.prg
* contrib/hbnf/datecnfg.prg
* contrib/hbnf/dispmsg.prg
* contrib/hbnf/findith.prg
* contrib/hbnf/ftround.prg
* contrib/hbnf/gcd.prg
* contrib/hbnf/hex2dec.prg
* contrib/hbnf/linked.prg
* contrib/hbnf/menu1.prg
* contrib/hbnf/menutonf.prg
* contrib/hbnf/metaph.prg
* contrib/hbnf/netpv.prg
* contrib/hbnf/nooccur.prg
* contrib/hbnf/ntow.prg
* contrib/hbnf/pchr.prg
* contrib/hbnf/pegs.prg
* contrib/hbnf/popadder.prg
* contrib/hbnf/prtesc.prg
* contrib/hbnf/pvid.prg
* contrib/hbnf/savearr.prg
* contrib/hbnf/scregion.prg
* contrib/hbnf/sqzn.prg
* contrib/hbnf/tempfile.prg
* contrib/hbnf/vertmenu.prg
* manual formatting
! fixed few places where HB_UTF8TOSTR() call was missing
2012-09-26 11:39 UTC+0200 Viktor Szakats (harbour syenar.net)
* debian/control
* INSTALL

2
harbour/contrib/hbnf/aavg.prg
View File

@@ -26,7 +26,7 @@
#include "common.ch"
#define FORCE_BETWEEN(x,y,z) (y := MAX(MIN(y,z),x))
#define FORCE_BETWEEN( x, y, z ) ( y := MAX( MIN( y, z ), x ) )
FUNCTION FT_AAVG( aArray, nStartIndex, nEndIndex )

2
harbour/contrib/hbnf/adessort.prg
View File

@@ -26,7 +26,7 @@
#include "common.ch"
#define FORCE_BETWEEN(x,y,z) (y := MAX(MIN(y,z),x))
#define FORCE_BETWEEN( x, y, z ) ( y := MAX( MIN( y, z ), x ) )
FUNCTION FT_ADESSORT( aArray, nStartIndex, nEndIndex )

2
harbour/contrib/hbnf/aeminlen.prg
View File

@@ -33,7 +33,7 @@ PROCEDURE Main()
?
? "myarray1 := DIRECTORY()"
?
AEval( myarray1, {|v| QOut( PadR(v[1],12 ), v[2], v[3], v[4], v[5] ) } )
AEval( myarray1, {| v | QOut( PadR( v[ 1 ], 12 ), v[ 2 ], v[ 3 ], v[ 4 ], v[ 5 ] ) } )
var0 := FT_AEMINLEN( myarray1 )
? PadR( 'FT_AEMINLEN( myarray1 ) ->', 30 )
?? var0

2
harbour/contrib/hbnf/amedian.prg
View File

@@ -59,7 +59,7 @@ PROCEDURE Main()
#include "common.ch"
#define FORCE_BETWEEN(x,y,z) (y := MAX(MIN(y,z),x))
#define FORCE_BETWEEN( x, y, z ) ( y := MAX( MIN( y, z ), x ) )
FUNCTION FT_AMEDIAN( aArray, nStart, nEnd )

2
harbour/contrib/hbnf/anomatch.prg
View File

@@ -26,7 +26,7 @@
#include "common.ch"
#define FORCE_BETWEEN(x,y,z) (y := MAX(MIN(y,z),x))
#define FORCE_BETWEEN( x, y, z ) ( y := MAX( MIN( y, z ), x ) )
FUNCTION FT_ANOMATCHES( aArray, bCompareBlock, nStartIndex, nEndIndex )

10
harbour/contrib/hbnf/any2any.prg
View File

@@ -26,13 +26,13 @@
#include "common.ch"
#define BLOCKIFY(x) { || x }
#define CASE_AT(x,y,z) z[AT(x,y)+1]
#define BLOCKIFY( x ) {|| x }
#define CASE_AT( x, y, z ) z[ AT( x, y ) + 1 ]
#define NULL ""
#define EARLIEST_DATE STOD("01000101")
#define EARLIEST_DATE STOD( "01000101" )
#define BLANK_DATE STOD()
#define XTOC(x) CASE_AT(VALTYPE(x), "CNDLM", ;
#define XTOC( x ) CASE_AT( VALTYPE( x ), "CNDLM", ;
{ NULL, ;
x, ;
iif( HB_ISNUMERIC( x ), ;
@@ -112,4 +112,4 @@ FUNCTION FT_XTOY( xValueToConvert, cTypeToConvertTo, lWantYesNo )
ENDCASE
RETURN xValueToConvert // XToY
RETURN xValueToConvert

4
harbour/contrib/hbnf/asum.prg
View File

@@ -26,8 +26,8 @@
#include "common.ch"
#define CASE_AT(x,y,z) z[AT(x,y)+1]
#define FORCE_BETWEEN(x,y,z) (y := MAX(MIN(y,z),x))
#define CASE_AT( x, y, z ) z[ AT( x, y ) + 1 ]
#define FORCE_BETWEEN( x, y, z ) ( y := MAX( MIN( y, z ), x ) )
FUNCTION FT_ASUM( aArray, nStartIndex, nEndIndex )

108
harbour/contrib/hbnf/clrsel.prg
View File

@@ -101,7 +101,7 @@ PROCEDURE Main( cVidMode )
LOCAL nColDos := Col()
LOCAL lBlink := SetBlink( .F. ) // make sure it starts out .F.
LOCAL aEnvDos := FT_SaveSets()
LOCAL cScrDos := SaveScreen( 00, 00, MaxRow(), MaxCol() )
LOCAL cScrDos := SaveScreen( 0, 0, MaxRow(), MaxCol() )
LOCAL lColour := .F.
LOCAL aClrs := {}
@@ -138,7 +138,7 @@ PROCEDURE Main( cVidMode )
//.... restore the DOS environment
FT_RestSets( aEnvDos )
RestScreen( 00, 00, MaxRow(), MaxCol(), cScrDos )
RestScreen( 0, 0, MaxRow(), MaxCol(), cScrDos )
SetPos( nRowDos, nColDos )
SetBlink( .F. ) // doesn't appear to be reset from FT_RestSets
@@ -165,7 +165,7 @@ FUNCTION FT_ClrSel( aClrs, lColour, cChr )
LOCAL nRowSav := Row()
LOCAL nColSav := Col()
LOCAL aEnvSav := FT_SaveSets()
LOCAL cScrSav := SaveScreen( 00, 00, MaxRow(), MaxCol() )
LOCAL cScrSav := SaveScreen( 0, 0, MaxRow(), MaxCol() )
DEFAULT lColour TO IsColor()
DEFAULT cChr TO Chr( 254 ) + Chr( 254 )
@@ -182,19 +182,19 @@ FUNCTION FT_ClrSel( aClrs, lColour, cChr )
_ftShowPal( aClrPal, cChr )
//.... Determine length of longest name and make sure not greater than 20
AEval( aClrs, { |aOpt| nLen := Max( nLen, Len( aOpt[C_NAME] ) ) } )
AEval( aClrs, {| aOpt | nLen := Max( nLen, Len( aOpt[ C_NAME ] ) ) } )
nLen := Min( Max( nLen, 1 ), 20 ) + 2
//.... prepare an array for use with aChoice(); truncate names at 20 chrs.
aPrompt := Array( Len( aClrs ) )
AEval( aClrs, ;
{ |aOpt, nE| aPrompt[nE] := " " + SUBS( aOpt[C_NAME], 1, nLen - 2 ) + " " };
{| aOpt, nE | aPrompt[ nE ] := " " + SubStr( aOpt[ C_NAME ], 1, nLen - 2 ) + " " };
)
//.... determine co-ordinates for the achoice window
nT := Max( Int( (18 - Len(aPrompt ) ) /2 ) - 1, 1 )
nT := Max( Int( ( 18 - Len( aPrompt ) ) /2 ) - 1, 1 )
nB := Min( nT + Len( aPrompt ) + 1, 17 )
nL := Max( Int( (27 - nLen ) /2 ) - 2, 1 )
nL := Max( Int( ( 27 - nLen ) /2 ) - 2, 1 )
nR := Min( nL + nLen + 3, 26 )
//.... set up the window for aChoice
@@ -220,7 +220,7 @@ FUNCTION FT_ClrSel( aClrs, lColour, cChr )
ENDIF
FT_RestSets( aEnvSav )
RestScreen( 00, 00, MaxRow(), MaxCol(), cScrSav )
RestScreen( 0, 0, MaxRow(), MaxCol(), cScrSav )
SetPos( nRowSav, nColSav )
RETURN iif( nChoice == 1, aClrs, aClrOld )
@@ -230,7 +230,7 @@ FUNCTION FT_ClrSel( aClrs, lColour, cChr )
STATIC FUNCTION _ftHiLite( nRow, nCol, cStr, nLen )
// Highlight the current selected aChoice element
// Return -> Nil
// Return -> NIL
LOCAL cClr := SetColor()
LOCAL aClr := _ftChr2Arr( cClr )
@@ -239,7 +239,7 @@ STATIC FUNCTION _ftHiLite( nRow, nCol, cStr, nLen )
@ nRow, nCol SAY PadR( cStr, nLen )
SetColor( cClr )
RETURN Nil
RETURN NIL
//------------------------------------------------
@@ -256,7 +256,7 @@ STATIC FUNCTION _ftColours( aOpt, aClrPal, lColour )
LOCAL aPrompt
LOCAL nLen := 0
LOCAL cColour := SetColor()
LOCAL cScrSav := SaveScreen( 18, 00, MaxRow(), MaxCol() )
LOCAL cScrSav := SaveScreen( 18, 0, MaxRow(), MaxCol() )
ASize( aOpt, 4 ) // check incoming parameters
DEFAULT aOpt[ C_CHAR ] TO ""
@@ -282,11 +282,11 @@ STATIC FUNCTION _ftColours( aOpt, aClrPal, lColour )
IF !( aOpt[ C_TYPE ] == "T" ) // no prompt for titles
//.... we need to know top,left,bottom,right for the prompt window
AEval( aPrompt, { |cPrompt| nLen := Max( nLen, Len( cPrompt ) ) } )
AEval( aPrompt, {| cPrompt | nLen := Max( nLen, Len( cPrompt ) ) } )
nLen := Max( nLen, Len( aOpt[ C_NAME ] ) + 2 )
nT := iif( aOpt[ C_TYPE ] == "M", 18, 19 )
nB := nT + Len( aPrompt ) + 1
nL := Max( Int( (27 - nLen ) /2 ) - 2, 1 )
nL := Max( Int( ( 27 - nLen ) /2 ) - 2, 1 )
nR := Min( nL + nLen + 3, 26 )
//.... set up the window for prompt
@@ -302,9 +302,9 @@ STATIC FUNCTION _ftColours( aOpt, aClrPal, lColour )
IF !( aOpt[ C_TYPE ] == "T" ) // no prompt for titles
SetColor( iif( lColour, "N/W,W+/R,,,N/W", "N/W,W+/N,,,N/W" ) )
Double( nT, nL + 1, nB, nR - 1 )
@ nT, nL + 2 SAY PadC( " " + aOpt[C_NAME] + " ", nR - nL - 3, hb_UTF8ToStr( "═" ) )
@ nT, nL + 2 SAY PadC( " " + aOpt[ C_NAME ] + " ", nR - nL - 3, hb_UTF8ToStr( "═" ) )
FOR nX := 1 TO Len( aPrompt )
@ nX + nT, nL + 2 PROMPT PadR( aPrompt[nX], nR - nL - 3 )
@ nX + nT, nL + 2 PROMPT PadR( aPrompt[ nX ], nR - nL - 3 )
NEXT
MENU TO nChoice
@@ -323,13 +323,13 @@ STATIC FUNCTION _ftColours( aOpt, aClrPal, lColour )
//.... get the specific colour combination
aClrs := _ftChr2Arr( aOpt[ C_CLR ] ) // place color string in an array
ASize( aClrs, 5 ) // make sure there are 5 settings
//.... empty elements are made Nil so they can be defaulted
AEval( aClrs, { |v, e| aClrs[e] := iif( Empty(v ), Nil, AllTrim(v ) ) } )
DEFAULT aClrs[1] TO "W/N"
DEFAULT aClrs[2] TO "N/W" // place default colours into
DEFAULT aClrs[3] TO "N/N" // elements which are empty
DEFAULT aClrs[4] TO "N/N"
DEFAULT aClrs[5] TO "N/W"
//.... empty elements are made NIL so they can be defaulted
AEval( aClrs, {| v, e | aClrs[ e ] := iif( Empty( v ), NIL, AllTrim( v ) ) } )
DEFAULT aClrs[ 1 ] TO "W/N"
DEFAULT aClrs[ 2 ] TO "N/W" // place default colours into
DEFAULT aClrs[ 3 ] TO "N/N" // elements which are empty
DEFAULT aClrs[ 4 ] TO "N/N"
DEFAULT aClrs[ 5 ] TO "N/W"
cClr := aClrs[ nChoice ] // selected colour
//.... allow change to specific part of colour string
@@ -358,7 +358,7 @@ STATIC FUNCTION _ftColours( aOpt, aClrPal, lColour )
STATIC FUNCTION _ftShowIt( aOpt )
// Show an example of the colour setting
// Return -> Nil
// Return -> NIL
LOCAL aClr := _ftChr2Arr( aOpt[ C_CLR ] )
@@ -370,61 +370,61 @@ STATIC FUNCTION _ftShowIt( aOpt )
DO CASE
CASE aOpt[ C_TYPE ] == "D" // Desktop Background
SetColor( aClr[1] )
SetColor( aClr[ 1 ] )
BkGrnd( 19, 43, 22, 64, aOpt[ C_CHAR ] )
CASE aOpt[ C_TYPE ] == "T" // Title
SetColor( aClr[1] )
SetColor( aClr[ 1 ] )
@ 20, 08 SAY PadC( "This is an example of how the text shall look", 63 )
CASE aOpt[ C_TYPE ] == "M" // Menus
SetColor( "W/N" )
BkGrnd( 19, 41, 23, 66, Chr( 177 ) )
SetColor( aClr[1] )
SetColor( aClr[ 1 ] )
Single( 19, 43, 22, 60 )
@ 18, 41 SAY " Report Inquiry Quit "
@ 21, 44 SAY " eXit "
SetColor( aClr[4] )
SetColor( aClr[ 4 ] )
@ 18, 43 SAY " Report "
@ 20, 44 SAY " Product List "
SetColor( aClr[3] )
SetColor( aClr[ 3 ] )
@ 18, 52 SAY "I"
@ 18, 61 SAY "Q"
@ 21, 46 SAY "X"
SetColor( aClr[5] )
SetColor( aClr[ 5 ] )
@ 18, 44 SAY "R"
@ 20, 45 SAY "P"
SetColor( aClr[2] )
SetColor( aClr[ 2 ] )
@ 24, 41 SAY PadC( "Inventory Report", 26 )
CASE aOpt[ C_TYPE ] == "G" // Get windows
SetColor( aClr[1] )
SetColor( aClr[ 1 ] )
ClearS( 19, 41, 24, 66 )
Single( 19, 42, 24, 65 )
@ 20, 43 SAY " Invoice Entry "
@ 21, 42 SAY hb_UTF8ToStr( "├──────────────────────┤" )
@ 22, 43 SAY " Amount "
@ 23, 43 SAY " Date "
SetColor( aClr[2] )
SetColor( aClr[ 2 ] )
@ 22, 53 SAY " 199.95"
SetColor( aClr[5] )
SetColor( aClr[ 5 ] )
@ 23, 53 SAY "09/15/91"
CASE aOpt[ C_TYPE ] == "W" // Alert windows
SetColor( aClr[1] )
SetColor( aClr[ 1 ] )
ClearS( 18, 40, 24, 66 )
Single( 18, 41, 24, 65 )
@ 19, 42 SAY " "
@ 20, 42 SAY " Test Message "
@ 21, 42 SAY " "
@ 22, 41 SAY hb_UTF8ToStr( "├───────────────────────┤" )
SetColor( aClr[2] )
SetColor( aClr[ 2 ] )
@ 23, 44 SAY " Accept "
SetColor( aClr[5] )
SetColor( aClr[ 5 ] )
@ 23, 55 SAY " Reject "
CASE aOpt[ C_TYPE ] == "B" // browse windows
SetColor( aClr[1] )
SetColor( aClr[ 1 ] )
ClearS( 18, 37, 24, 70 )
Single( 18, 38, 24, 69 )
@ 19, 39 SAY " Cust Name Amount "
@@ -432,29 +432,29 @@ STATIC FUNCTION _ftShowIt( aOpt )
@ 21, 39 SAY hb_UTF8ToStr( " 312 │ Rick Shaw │ 143.25 " )
@ 23, 39 SAY hb_UTF8ToStr( " │ │ " )
@ 24, 38 SAY hb_UTF8ToStr( "╘══════╧══════════════╧════════╛" )
SetColor( aClr[2] )
SetColor( aClr[ 2 ] )
@ 22, 39 SAY hb_UTF8ToStr( " 1005 │ Harry Pitts │ 78.95 " )
SetColor( aClr[5] )
SetColor( aClr[ 5 ] )
@ 23, 39 SAY " 3162 "
@ 23, 46 SAY " Barb Wire "
@ 23, 61 SAY " 345.06 "
CASE aOpt[ C_TYPE ] == "A" // achoice type window
SetColor( aClr[1] )
SetColor( aClr[ 1 ] )
ClearS( 18, 42, 24, 64 )
Single( 18, 43, 24, 63 )
@ 19, 44 SAY " Daily Reports "
@ 21, 44 SAY " Quarterly Reports "
@ 23, 44 SAY " Exit ... <Esc> "
SetColor( aClr[2] )
SetColor( aClr[ 2 ] )
@ 20, 44 SAY " Monthend Reports "
SetColor( aClr[5] )
SetColor( aClr[ 5 ] )
@ 22, 44 SAY " Yearend Reports "
ENDCASE
DispEnd()
RETURN Nil
RETURN NIL
//------------------------------------------------
@@ -565,16 +565,16 @@ STATIC FUNCTION _ftDeskChar( aOpt )
//.... draw the choices on the screen
SetColor( cClr )
FOR n := 1 TO Len( aChar )
@ n + 18, 29 SAY REPL( aChar[n], 10 )
@ n + 18, 29 SAY REPLICATE( aChar[ n ], 10 )
NEXT
n := nElem + 18
DO WHILE .T.
//.... make sure boundary not exeeded
n := iif( n > Len( aChar ) + 18, 19, iif( n < 19, Len(aChar ) + 18, n ) )
n := iif( n > Len( aChar ) + 18, 19, iif( n < 19, Len( aChar ) + 18, n ) )
//.... show sample window
aOpt[ C_CHAR ] := aChar[ n-18 ] // place in array
aOpt[ C_CHAR ] := aChar[ n - 18 ] // place in array
_ftShowIt( aOpt )
SetColor( "W+/N" )
@@ -613,10 +613,12 @@ STATIC FUNCTION _ftChr2Arr( cString, cDelim )
cString += cDelim
DO WHILE .T.
IF Empty( cString ) ; EXIT ; ENDIF
IF Empty( cString )
EXIT
ENDIF
n := At( cDelim, cString )
AAdd( aArray, iif( n == 1, "", Left( cString, n - 1 ) ) )
cString := SUBS( cString, n + 1 )
cString := SubStr( cString, n + 1 )
ENDDO
RETURN aArray
@@ -633,7 +635,7 @@ STATIC FUNCTION _ftArr2Chr( aArray, cDelim )
DEFAULT aArray TO {}
DEFAULT cDelim TO ","
AEval( aArray, { |v, e| cString += iif( e == 1, v, cDelim + v ) } )
AEval( aArray, {| v, e | cString += iif( e == 1, v, cDelim + v ) } )
RETURN cString
@@ -642,7 +644,7 @@ STATIC FUNCTION _ftArr2Chr( aArray, cDelim )
STATIC FUNCTION _ftShowPal( aClrPal, cChr )
// Paint the palette on the screen
// Return -> Nil
// Return -> NIL
LOCAL nF, nB
LOCAL nTop := 0
@@ -661,7 +663,7 @@ STATIC FUNCTION _ftShowPal( aClrPal, cChr )
NEXT
DispEnd()
RETURN Nil
RETURN NIL
//------------------------------------------------
@@ -678,8 +680,8 @@ STATIC FUNCTION _ftInitPal( aClrTab )
FOR nF := 1 TO nDim * 2
FOR nB := 1 TO nDim * 2
aClrPal[ nF, nB ] := ;
iif( nF <= nDim, aClrTab[ nF ], aClrTab[ nF-nDim ] + "+" ) + "/" + ;
iif( nB <= nDim, aClrTab[ nB ], aClrTab[ nB-nDim ] + "*" )
iif( nF <= nDim, aClrTab[ nF ], aClrTab[ nF - nDim ] + "+" ) + "/" + ;
iif( nB <= nDim, aClrTab[ nB ], aClrTab[ nB - nDim ] + "*" )
NEXT
NEXT

4
harbour/contrib/hbnf/d2e.prg
View File

@@ -34,7 +34,7 @@
PROCEDURE Main( cNum, cPrec )
DEFAULT cPrec TO Str( DEFAULT_PRECISION )
QOut( ft_d2e( Val(cNum ), Val(cPrec ) ) )
QOut( ft_d2e( Val( cNum ), Val( cPrec ) ) )
RETURN
@@ -51,7 +51,7 @@ FUNCTION ft_d2e( nDec, nPrecision )
ELSEIF Abs( nDec ) < 1
nExp := Int( log10( nDec ) ) - 1
ELSE
nExp := Int( log10( Abs(nDec ) + 0.00001 ) ) /* 0.00001 == kludge */
nExp := Int( log10( Abs( nDec ) + 0.00001 ) ) /* 0.00001 == kludge */
ENDIF /* for imprecise logs */
nDec /= 10 ^ nExp

4
harbour/contrib/hbnf/datecnfg.prg
View File

@@ -247,9 +247,9 @@ FUNCTION FT_DATECNFG( cFYStart , nDow )
dCheck --
ENDIF
SET( _SET_DATEFORMAT, "yyyy.mm.dd" )
Set( _SET_DATEFORMAT, "yyyy.mm.dd" )
t_aDatePar[ 1 ] := DToC( dCheck )
SET( _SET_DATEFORMAT, cDateFormat )
Set( _SET_DATEFORMAT, cDateFormat )
ENDIF
ENDIF

2
harbour/contrib/hbnf/dispmsg.prg
View File

@@ -130,7 +130,7 @@ FUNCTION FT_DispMsg( aInfo, cKey, nBoxTop, nBoxLeft, cnBoxString, lShadow )
NEXT
AEval( aInfo[1], {|x| nWidest := Max( nWidest, Len( x ) ) } )
AEval( aInfo[ 1 ], {| x | nWidest := Max( nWidest, Len( x ) ) } )
/* calculate location of data */
IF nBoxLeft == NIL

4
harbour/contrib/hbnf/findith.prg
View File

@@ -24,7 +24,7 @@
*
*/
#define MAKE_UPPER(cString) (cString := UPPER(cString))
#define MAKE_UPPER( cString ) ( cString := UPPER( cString ) )
#define NULL ""
#ifdef FT_TEST
@@ -66,7 +66,7 @@ FUNCTION FT_FINDITH( cCheckFor, cCheckIn, nWhichOccurrence, lIgnoreCase )
RETURN iif( nWhichOccurrence == 1, ;
At( cCheckFor, cCheckIn ), ;
iif( ( nIthOccurrence := At(cCheckFor, ;
iif( ( nIthOccurrence := At( cCheckFor, ;
StrTran( cCheckIn, cCheckFor, ;
NULL, 1, ;
nWhichOccurrence - 1 ) ) ) == 0, ;

8
harbour/contrib/hbnf/ftround.prg
View File

@@ -50,7 +50,7 @@ FUNCTION FT_ROUND( nNumber, nRoundToAmount, cRoundType, cRoundDirection, ;
// No, Are We Rounding to the Nearest
// Decimal Place??
IF ( Left( cRoundType, 1 ) == NEAREST_DECIMAL )
IF Left( cRoundType, 1 ) == NEAREST_DECIMAL
// Yes, Convert to Nearest Fraction
nRoundToAmount := 10 ** nRoundToAmount
@@ -59,7 +59,7 @@ FUNCTION FT_ROUND( nNumber, nRoundToAmount, cRoundType, cRoundDirection, ;
// Are We Already Within the Acceptable
// Error Factor??
IF ( Abs( Int(nResult * nRoundToAmount ) - ( nResult * nRoundToAmount ) ) > ;
IF ( Abs( Int( nResult * nRoundToAmount ) - ( nResult * nRoundToAmount ) ) > ;
nAcceptableError )
// No, Are We Rounding Down??
nResult -= iif( Left( cRoundDirection, 1 ) == ROUND_DOWN, ;
@@ -75,8 +75,8 @@ FUNCTION FT_ROUND( nNumber, nRoundToAmount, cRoundType, cRoundDirection, ;
nResult := Int( ( nRoundToAmount * nResult ) + .5 + nAcceptableError ) / ;
nRoundToAmount
ENDIF // ABS(INT(nResult * nRoundToAmount) -
// (mResult * nRoundAmount)) >
ENDIF // ABS( INT( nResult * nRoundToAmount ) -
// ( mResult * nRoundAmount ) ) >
// nAcceptableError
ELSE // Yes, Round to Nearest Whole Number

2
harbour/contrib/hbnf/gcd.prg
View File

@@ -28,7 +28,7 @@
PROCEDURE Main( cNum1, cNum2 )
OutStd( Str( FT_GCD( Val(cNum1 ), Val(cNum2 ) ) ) + hb_eol() )
OutStd( Str( FT_GCD( Val( cNum1 ), Val( cNum2 ) ) ) + hb_eol() )
RETURN

4
harbour/contrib/hbnf/hex2dec.prg
View File

@@ -43,8 +43,8 @@ FUNCTION FT_HEX2DEC( cHexNum )
LOCAL n, nDec := 0, nHexPower := 1
FOR n := Len( cHexNum ) TO 1 step - 1
nDec += ( At( subs( Upper(cHexNum ), n, 1 ), HEXTABLE ) - 1 ) * nHexPower
FOR n := Len( cHexNum ) TO 1 STEP -1
nDec += ( At( subs( Upper( cHexNum ), n, 1 ), HEXTABLE ) - 1 ) * nHexPower
nHexPower *= 16
NEXT

11
harbour/contrib/hbnf/linked.prg
View File

@@ -45,7 +45,7 @@ PROCEDURE Main()
CLS
@ 1, 0 SAY "String Tested Result"
@ 2, 0 TO 2, MaxCol()
AEval( aString, {|ele, num| QOut( ele, Space(45 - Len(ele ) ), FT_Linked(ele ) ) } )
AEval( aString, {| ele, num | QOut( ele, Space( 45 - Len( ele ) ), FT_Linked( ele ) ) } )
@ MaxRow() - 2, 0
RETURN
@@ -68,12 +68,13 @@ FUNCTION FT_Linked( cFuncs )
// No functions in string
Alert( "Warning: Expected function(s) in FT_Linked(), but none were found" )
ELSE
DO WHILE ( nFEnd := At( "(",cFuncs ) ) > 0
DO WHILE ( nFEnd := At( "(", cFuncs ) ) > 0
// Add the current function to the array of functions
AAdd( aFuncArray, Left( cFuncs,nFEnd ) + ")" )
AAdd( aFuncArray, Left( cFuncs, nFEnd ) + ")" )
// Remove the current function from the string
cFuncs := SubStr( cFuncs, nFEnd + 1 )
nSpace := At( " ", cFuncs ) ; nComma := At( ",", cFuncs )
nSpace := At( " ", cFuncs )
nComma := At( ",", cFuncs )
DO WHILE ( nComma > 0 .AND. nComma < nFEnd ) .OR. ;
( nSpace > 0 .AND. nSpace < nFEnd )
// We have extra parameters or spaces prior to the start
@@ -89,7 +90,7 @@ FUNCTION FT_Linked( cFuncs )
ENDDO
// Scan through the array of functions, stop after the first occurence
// of a function which returns a TYPE() of "U" (hence is not linked in)
lRetVal := AScan( aFuncArray, {|element| Type( element ) == "U" } ) = 0
lRetVal := AScan( aFuncArray, {| element | Type( element ) == "U" } ) = 0
ENDIF
RETURN lRetVal

127
harbour/contrib/hbnf/menu1.prg
View File

@@ -60,8 +60,12 @@
#define SCNONE 0
#define SCNORMAL 1
THREAD STATIC ACHOICES := {}, AVALIDKEYS := {}
THREAD STATIC NHPOS, NVPOS, NMAXROW, NMAXCOL
THREAD STATIC aChoices := {}
THREAD STATIC aValidKeys := {}
THREAD STATIC nHPos
THREAD STATIC nVPos
THREAD STATIC nMaxRow
THREAD STATIC nMaxCol
// BEGINNING OF DEMO PROGRAM
#ifdef FT_TEST
@@ -81,7 +85,7 @@ PROCEDURE CALLMENU( cCmdLine )
LOCAL aColors := {}
LOCAL aBar := { " ENTER/EDIT ", " REPORTS ", " DISPLAY ", " MAINTENANCE ", " QUIT " }
LOCAL aOptions[ LEN( aBar ) ]
AEval( aBar, { |x, i| aOptions[i] := { {},{},{} } } )
AEval( aBar, {| x, i | aOptions[ i ] := { {}, {}, {} } } )
cCmdLine := iif( cCmdLine == NIL, "", cCmdLine )
@@ -91,41 +95,41 @@ PROCEDURE CALLMENU( cCmdLine )
aColors := iif( lColor, { "W+/G", "N/G", "N/G", "N/W", "N+/G" }, ;
{ "W+/N", "W+/N", "W/N", "N/W", "W/N" } )
FT_FILL( aOptions[1], 'A. Execute A Dummy Procedure' , {|| fubar() }, .T. )
FT_FILL( aOptions[1], 'B. Enter Daily Charge/Credit Slips' , {|| .T. }, .T. )
FT_FILL( aOptions[1], 'C. Enter Payments On Accounts' , {|| .T. }, .F. )
FT_FILL( aOptions[1], 'D. Edit Daily Transactions' , {|| .T. }, .T. )
FT_FILL( aOptions[1], 'E. Enter/Update Member File' , {|| .T. }, .T. )
FT_FILL( aOptions[1], 'F. Update Code File' , {|| .T. }, .F. )
FT_FILL( aOptions[1], 'G. Add/Update Auto Charge File' , {|| .T. }, .T. )
FT_FILL( aOptions[1], 'H. Post All Transactions To A/R File', {|| .T. }, .T. )
FT_FILL( aOptions[1], 'I. Increment Next Posting Date' , {|| .T. }, .T. )
FT_FILL( aOptions[ 1 ], 'A. Execute A Dummy Procedure' , {|| fubar() }, .T. )
FT_FILL( aOptions[ 1 ], 'B. Enter Daily Charge/Credit Slips' , {|| .T. }, .T. )
FT_FILL( aOptions[ 1 ], 'C. Enter Payments On Accounts' , {|| .T. }, .F. )
FT_FILL( aOptions[ 1 ], 'D. Edit Daily Transactions' , {|| .T. }, .T. )
FT_FILL( aOptions[ 1 ], 'E. Enter/Update Member File' , {|| .T. }, .T. )
FT_FILL( aOptions[ 1 ], 'F. Update Code File' , {|| .T. }, .F. )
FT_FILL( aOptions[ 1 ], 'G. Add/Update Auto Charge File' , {|| .T. }, .T. )
FT_FILL( aOptions[ 1 ], 'H. Post All Transactions To A/R File', {|| .T. }, .T. )
FT_FILL( aOptions[ 1 ], 'I. Increment Next Posting Date' , {|| .T. }, .T. )
FT_FILL( aOptions[2], 'A. Print Member List' , {|| .T. }, .T. )
FT_FILL( aOptions[2], 'B. Print Active Auto Charges' , {|| .T. }, .T. )
FT_FILL( aOptions[2], 'C. Print Edit List' , {|| .T. }, .T. )
FT_FILL( aOptions[2], 'D. Print Pro-Usage Report' , {|| .T. }, .T. )
FT_FILL( aOptions[2], 'E. Print A/R Transaction Report' , {|| .T. }, .T. )
FT_FILL( aOptions[2], 'F. Aging Report Preparation' , {|| .T. }, .T. )
FT_FILL( aOptions[2], 'G. Add Interest Charges' , {|| .T. }, .T. )
FT_FILL( aOptions[2], 'H. Print Aging Report' , {|| .T. }, .T. )
FT_FILL( aOptions[2], 'I. Print Monthly Statements' , {|| .T. }, .T. )
FT_FILL( aOptions[2], 'J. Print Mailing Labels' , {|| .T. }, .T. )
FT_FILL( aOptions[2], 'K. Print Transaction Totals' , {|| .T. }, .T. )
FT_FILL( aOptions[2], 'L. Print Transaction Codes File' , {|| .T. }, .T. )
FT_FILL( aOptions[2], 'M. Print No-Activity List' , {|| .T. }, .T. )
FT_FILL( aOptions[ 2 ], 'A. Print Member List' , {|| .T. }, .T. )
FT_FILL( aOptions[ 2 ], 'B. Print Active Auto Charges' , {|| .T. }, .T. )
FT_FILL( aOptions[ 2 ], 'C. Print Edit List' , {|| .T. }, .T. )
FT_FILL( aOptions[ 2 ], 'D. Print Pro-Usage Report' , {|| .T. }, .T. )
FT_FILL( aOptions[ 2 ], 'E. Print A/R Transaction Report' , {|| .T. }, .T. )
FT_FILL( aOptions[ 2 ], 'F. Aging Report Preparation' , {|| .T. }, .T. )
FT_FILL( aOptions[ 2 ], 'G. Add Interest Charges' , {|| .T. }, .T. )
FT_FILL( aOptions[ 2 ], 'H. Print Aging Report' , {|| .T. }, .T. )
FT_FILL( aOptions[ 2 ], 'I. Print Monthly Statements' , {|| .T. }, .T. )
FT_FILL( aOptions[ 2 ], 'J. Print Mailing Labels' , {|| .T. }, .T. )
FT_FILL( aOptions[ 2 ], 'K. Print Transaction Totals' , {|| .T. }, .T. )
FT_FILL( aOptions[ 2 ], 'L. Print Transaction Codes File' , {|| .T. }, .T. )
FT_FILL( aOptions[ 2 ], 'M. Print No-Activity List' , {|| .T. }, .T. )
FT_FILL( aOptions[3], 'A. Transaction Totals Display' , {|| .T. }, .T. )
FT_FILL( aOptions[3], 'B. Display Invoice Totals' , {|| .T. }, .T. )
FT_FILL( aOptions[3], 'C. Accounts Receivable Display' , {|| .T. }, .T. )
FT_FILL( aOptions[ 3 ], 'A. Transaction Totals Display' , {|| .T. }, .T. )
FT_FILL( aOptions[ 3 ], 'B. Display Invoice Totals' , {|| .T. }, .T. )
FT_FILL( aOptions[ 3 ], 'C. Accounts Receivable Display' , {|| .T. }, .T. )
FT_FILL( aOptions[4], 'A. Backup Database Files' , {|| .T. }, .T. )
FT_FILL( aOptions[4], 'B. Reindex Database Files' , {|| .T. }, .T. )
FT_FILL( aOptions[4], 'C. Set System Parameters' , {|| .T. }, .T. )
FT_FILL( aOptions[4], 'D. This EXITs Too' , {|| .F. }, .T. )
FT_FILL( aOptions[ 4 ], 'A. Backup Database Files' , {|| .T. }, .T. )
FT_FILL( aOptions[ 4 ], 'B. Reindex Database Files' , {|| .T. }, .T. )
FT_FILL( aOptions[ 4 ], 'C. Set System Parameters' , {|| .T. }, .T. )
FT_FILL( aOptions[ 4 ], 'D. This EXITs Too' , {|| .F. }, .T. )
FT_FILL( aOptions[5], 'A. Does Nothing' , {|| .T. }, .T. )
FT_FILL( aOptions[5], 'B. Exit To DOS' , {|| .F. }, .T. )
FT_FILL( aOptions[ 5 ], 'A. Does Nothing' , {|| .T. }, .T. )
FT_FILL( aOptions[ 5 ], 'B. Exit To DOS' , {|| .F. }, .T. )
// main routine starts here
SET SCOREBOARD OFF
@@ -145,7 +149,7 @@ PROCEDURE CALLMENU( cCmdLine )
nDosCol := Col()
SetColor( "w/n" )
CLS
NoSnow( ( "NOSNOW" $ Upper( cCmdLine ) ) )
NoSnow( "NOSNOW" $ Upper( cCmdLine ) )
IF "VGA" $ Upper( cCmdLine )
SetMode( 50, 80 )
ENDIF
@@ -204,10 +208,10 @@ FUNCTION FT_MENU1( aBar, aOptions, aColors, nTopRow, lShadow )
LOCAL sMainScrn, lCancMode, lLooping := .T.
// column position for each item on the menu bar
LOCAL aBarCol[LEN(aBar)]
LOCAL aBarCol[ Len( aBar ) ]
// inkey code for each item on menu bar
LOCAL aBarKeys[ LEN( aBar ) ]
LOCAL aBarKeys[ Len( aBar ) ]
// inkey codes for A - Z
LOCAL aKeyCodes := { 286, 304, 302, 288, 274, 289, 290, 291, 279, ;
@@ -215,20 +219,20 @@ FUNCTION FT_MENU1( aBar, aOptions, aColors, nTopRow, lShadow )
287, 276, 278, 303, 273, 301, 277, 300 }
// LEN() of widest array element for for each pulldown menu
LOCAL aBarWidth[LEN(aBar)]
LOCAL aBarWidth[ Len( aBar ) ]
// starting column for each box
LOCAL aBoxLoc[LEN(aBar)]
LOCAL aBoxLoc[ Len( aBar ) ]
// last selection for each element
LOCAL aLastSel[LEN(aBar)]
LOCAL aLastSel[ Len( aBar ) ]
// color memvars
LOCAL cBorder := aColors[1]
LOCAL cBox := aColors[2]
LOCAL cBar := aColors[3]
LOCAL cCurrent := aColors[4]
LOCAL cUnSelec := aColors[5]
LOCAL cBorder := aColors[ 1 ]
LOCAL cBox := aColors[ 2 ]
LOCAL cBar := aColors[ 3 ]
LOCAL cCurrent := aColors[ 4 ]
LOCAL cUnSelec := aColors[ 5 ]
nMaxRow := MaxRow()
nMaxCol := MaxCol()
@@ -243,33 +247,33 @@ FUNCTION FT_MENU1( aBar, aOptions, aColors, nTopRow, lShadow )
// on the menu bar.
aBarCol[1] := 0
nTtlUsed := Len( aBar[1] ) + 1
nTtlUsed := Len( aBar[ 1 ] ) + 1
AEval( aBar, ;
{|x, i| HB_SYMBOL_UNUSED( x ), aBarcol[i] := nTtlUsed, nTtlUsed += ( Len( aBar[i] ) + 1 ) }, ;
{| x, i | HB_SYMBOL_UNUSED( x ), aBarcol[ i ] := nTtlUsed, nTtlUsed += ( Len( aBar[ i ] ) + 1 ) }, ;
2, Len( aBar ) - 1 )
// calculates widest element for each pulldown menu
// see below for _ftWidest()
AFill( aBarWidth, 1 )
AEval( aChoices, { |x, i| HB_SYMBOL_UNUSED( x ), _ftWidest( @i, aChoices, @aBarWidth ) } )
AEval( aChoices, {| x, i | HB_SYMBOL_UNUSED( x ), _ftWidest( @i, aChoices, @aBarWidth ) } )
// box location for each pulldown menu
// see below for _ftLocat()
AEval( aChoices, { |x, i| HB_SYMBOL_UNUSED( x ), _ftLocat( i, aBarCol, aBarWidth, @aBoxLoc, nMaxCol ) } )
AEval( aChoices, {| x, i | HB_SYMBOL_UNUSED( x ), _ftLocat( i, aBarCol, aBarWidth, @aBoxLoc, nMaxCol ) } )
// valid keys for each pulldown menu
// see below for _ftValKeys()
AEval( aChoices, {|x, i| HB_SYMBOL_UNUSED( x ), AAdd( aValidkeys,"" ), ;
AEval( aChoices, {| x, i | HB_SYMBOL_UNUSED( x ), AAdd( aValidkeys, "" ), ;
_ftValKeys( i, aChoices, @aValidKeys ) } )
// display the menu bar
SetColor( cBar )
@ nTopRow, 0
AEval( aBar, { |x, i| HB_SYMBOL_UNUSED( x ), DevPos( nTopRow, aBarCol[i] ), DevOut( aBar[i] ) } )
AEval( aBar, {| x, i | HB_SYMBOL_UNUSED( x ), DevPos( nTopRow, aBarCol[ i ] ), DevOut( aBar[ i ] ) } )
// store inkey code for each item on menu bar to aBarKeys
AEval( aBarKeys, {|x, i| HB_SYMBOL_UNUSED( x ), aBarKeys[i] := ;
aKeyCodes[ ASC( UPPER( LTRIM( aBar[i] ) ) ) - 64 ] } )
AEval( aBarKeys, {| x, i | HB_SYMBOL_UNUSED( x ), aBarKeys[ i ] := ;
aKeyCodes[ Asc( Upper( LTrim( aBar[ i ] ) ) ) - 64 ] } )
// disable Alt-C and Alt-D
lCancMode := SetCancel( .F. )
@@ -278,18 +282,19 @@ FUNCTION FT_MENU1( aBar, aOptions, aColors, nTopRow, lShadow )
// main menu loop
SAVE SCREEN TO sMainScrn
// which menu and which menu item
nHpos := 1; nVpos := 1
nHpos := 1
nVpos := 1
DO WHILE lLooping
RESTORE SCREEN FROM sMainScrn
SetColor( cCurrent )
@ nTopRow, aBarCol[nHpos] SAY aBar[nHpos]
@ nTopRow, aBarCol[ nHpos ] SAY aBar[ nHpos ]
IF lShadow == NIL .OR. lShadow
FT_SHADOW( nTopRow + 1, aBoxLoc[nHpos], Len( aChoices[nHpos,1] ) + nTopRow + 2, aBarWidth[nHpos] + 3 + aBoxLoc[nHpos] )
FT_SHADOW( nTopRow + 1, aBoxLoc[ nHpos ], Len( aChoices[ nHpos, 1 ] ) + nTopRow + 2, aBarWidth[ nHpos ] + 3 + aBoxLoc[ nHpos ] )
ENDIF
SetColor( cBorder )
@ nTopRow + 1, aBoxLoc[nHpos], Len( aChoices[nHpos,1] ) + nTopRow + 2, aBarWidth[nHpos] + 3 + aBoxLoc[nHpos] BOX "╔═╗║╝═╚║ "
@ nTopRow + 1, aBoxLoc[ nHpos ], Len( aChoices[ nHpos, 1 ] ) + nTopRow + 2, aBarWidth[ nHpos ] + 3 + aBoxLoc[ nHpos ] BOX hb_UTF8ToStr( "╔═╗║╝═╚║ " )
SetColor( cBox + "," + cCurrent + ",,," + cUnselec )
nVpos := AChoice( nTopRow + 2, aBoxLoc[nHpos] + 2, Len( aChoices[nHpos,1] ) + nTopRow + 2, aBarWidth[nHpos] + 1 + aBoxLoc[nHpos], aChoices[nHpos,1], aChoices[nHpos,3], "__ftAcUdf", aLastSel[nHpos] )
nVpos := AChoice( nTopRow + 2, aBoxLoc[ nHpos ] + 2, Len( aChoices[ nHpos, 1 ] ) + nTopRow + 2, aBarWidth[ nHpos ] + 1 + aBoxLoc[ nHpos ], aChoices[ nHpos, 1 ], aChoices[ nHpos, 3 ], "__ftAcUdf", aLastSel[ nHpos ] )
DO CASE
CASE LastKey() == RIGHTARROW .OR. LastKey() == TAB
nHpos := iif( nHpos == Len( aChoices ), 1, nHpos + 1 )
@@ -302,7 +307,7 @@ FUNCTION FT_MENU1( aBar, aOptions, aColors, nTopRow, lShadow )
CASE LastKey() == END
nHpos := Len( aChoices )
CASE LastKey() == ENTER
aLastSel[nHpos] := nVpos
aLastSel[ nHpos ] := nVpos
IF aChoices[ nHpos, 2, nVpos ] != NIL
SetCancel( lCancMode )
AltD( ENABLE )
@@ -320,9 +325,9 @@ FUNCTION FT_MENU1( aBar, aOptions, aColors, nTopRow, lShadow )
RETURN NIL
// ACHOICE() user function
FUNCTION __ftAcUdf( nMode )
// ACHOICE() user function
LOCAL nRtnVal := RESUME
DO CASE
CASE nMode == HITTOP
@@ -331,7 +336,7 @@ FUNCTION __ftAcUdf( nMode )
KEYBOARD Chr( CTRLHOME )
CASE nMode == KEYEXCEPT
IF Upper( Chr( LastKey() ) ) $ aValidKeys[ nHpos ]
IF aChoices[ nHpos, 3, AT( UPPER( CHR( LASTKEY() ) ), aValidKeys[ nHpos ] )]
IF aChoices[ nHpos, 3, At( Upper( Chr( LastKey() ) ), aValidKeys[ nHpos ] ) ]
KEYBOARD Chr( ENTER )
nRtnVal := NEXTITEM
ENDIF

4
harbour/contrib/hbnf/menutonf.prg
View File

@@ -104,7 +104,7 @@ FUNCTION FT_Prompt( nRow, nCol, cPrompt, cColor, ;
// If message column not supplied, use the default
IF nMsgCol == NIL
IF SET( _SET_MCENTER )
IF Set( _SET_MCENTER )
nMsgCol := Int( ( MaxCol() + 1 - Len( cPrompt ) ) / 2 )
ELSE
nMsgCol := 0
@@ -426,7 +426,7 @@ FUNCTION FT_MenuTo( bGetSet, cReadVar, lCold )
aRight[ nLevel ] := {}
aExecute[ nLevel ] := {}
SET( _SET_CURSOR, nCursor )
Set( _SET_CURSOR, nCursor )
Eval( bGetSet, nActive )

4
harbour/contrib/hbnf/metaph.prg
View File

@@ -105,8 +105,8 @@ PROCEDURE Main()
LOCAL aNames := {}
LOCAL cName, nElem
SET( _SET_SCOREBOARD, .F. )
SET( _SET_COLOR, "W/B" )
Set( _SET_SCOREBOARD, .F. )
Set( _SET_COLOR, "W/B" )
CLS
// Demo will create an array of names and display in 3 columns

4
harbour/contrib/hbnf/netpv.prg
View File

@@ -38,12 +38,12 @@ FUNCTION FT_NETPV( nInitialInvestment, nInterestRate, aCashFlow, nNoOfCashFlows
LOCAL nNetPresentValue := 0
nNoOfCashFlows := iif( nNoOfCashFlows == nil, Len( aCashFlow ), nNoOfCashFlows )
nNoOfCashFlows := iif( nNoOfCashFlows == NIL, Len( aCashFlow ), nNoOfCashFlows )
AEval( aCashFlow, ;
{| nElement, nElementNo | ;
nNetPresentValue += nElement / ;
( ( 1 + (nInterestRate / 100 ) ) ** nElementNo ) }, ;
( ( 1 + ( nInterestRate / 100 ) ) ** nElementNo ) }, ;
1, nNoOfCashFlows )
RETURN nNetPresentValue -= nInitialInvestment

4
harbour/contrib/hbnf/nooccur.prg
View File

@@ -24,7 +24,7 @@
*
*/
#define MAKE_UPPER(x) ( x := UPPER( x ) )
#define MAKE_UPPER( x ) ( x := UPPER( x ) )
FUNCTION FT_NOOCCUR( cCheckFor, cCheckIn, lIgnoreCase )
@@ -34,7 +34,7 @@ FUNCTION FT_NOOCCUR( cCheckFor, cCheckIn, lIgnoreCase )
MAKE_UPPER( cCheckFor ) // No, Force Everything to Uppercase
MAKE_UPPER( cCheckIn )
ENDIF // IS_NOT_LOGICAL(lIgnoreCase) or ;
ENDIF
// lIgnoreCase
RETURN iif( Len( cCheckFor ) == 0 .OR. Len( cCheckIn ) == 0, ;

2
harbour/contrib/hbnf/ntow.prg
View File

@@ -49,7 +49,7 @@ PROCEDURE Main( cNum )
FUNCTION ft_ntow( nAmount )
LOCAL nTemp, sResult := " ", nQualNo
LOCAL nDiv := 10 ^ ( Int( sol10(nAmount ) / 3 ) * 3 )
LOCAL nDiv := 10 ^ ( Int( sol10( nAmount ) / 3 ) * 3 )
nTemp := Int( nAmount % nDiv )
nAmount := Int( nAmount / nDiv )

8
harbour/contrib/hbnf/pchr.prg
View File

@@ -39,7 +39,7 @@ FUNCTION FT_PCHR( c_nums )
ENDIF
c_nums := Trim( c_nums ) + ",~,"
c_part := SubStr( c_nums, c_st + 1, At( ",",SubStr(c_nums,c_st + 2 ) ) )
c_part := SubStr( c_nums, c_st + 1, At( ",", SubStr( c_nums, c_st + 2 ) ) )
DO WHILE ! ( c_part == "~" .OR. c_part == "" )
@@ -51,9 +51,9 @@ FUNCTION FT_PCHR( c_nums )
ELSEIF SubStr( c_part, 1, 1 ) == "&"
c_upper := Upper( c_part )
c_t1 := At( SubStr( c_upper,2,1 ), c_hex ) - 1
c_t1 := At( SubStr( c_upper, 2, 1 ), c_hex ) - 1
IF c_t1 >- 1
c_t2 := At( SubStr( c_upper,3,1 ), c_hex ) - 1
c_t2 := At( SubStr( c_upper, 3, 1 ), c_hex ) - 1
IF c_t2 >- 1
c_t1 := c_t1 * 16 + c_t2
ENDIF
@@ -137,7 +137,7 @@ FUNCTION FT_PCHR( c_nums )
ENDIF
c_st := At( ",", SubStr( c_nums,c_st + 1 ) ) + c_st
c_st := At( ",", SubStr( c_nums, c_st + 1 ) ) + c_st
c_part := SubStr( c_nums, c_st + 1, At( ",", SubStr( c_nums, c_st + 2 ) ) )
ENDDO

44
harbour/contrib/hbnf/pegs.prg
View File

@@ -46,7 +46,7 @@ MEMVAR getlist
board_[xx, 4] - is the location occupied or not? .T. -> Yes, .F. -> No
*/
THREAD STATIC board_ := { { {0, 29, 2, 34}, {2, 4}, {3, 9}, .T. } , ;
THREAD STATIC board_ := { { { 0, 29, 2, 34 }, { 2, 4 }, { 3, 9 }, .T. } , ;
{ { 0, 37, 2, 42 }, { 5 }, { 10 }, .T. } , ;
{ { 0, 45, 2, 50 }, { 2, 6 }, { 1, 11 }, .T. } , ;
{ { 3, 29, 5, 34 }, { 5, 9 }, { 6, 16 }, .T. } , ;
@@ -90,12 +90,12 @@ FUNCTION FT_PEGS()
to validate entry when there is more than one possible move
*/
scanblock := { | a | a[2] == move2 }
scanblock := {| a | a[ 2 ] == move2 }
cls
SetColor( 'w/r' )
SINGLEBOX( 22, 31, 24, 48 )
@ 23, 33 SAY "Your move:"
AEval( board_, { | a, x | HB_SYMBOL_UNUSED( a ), drawbox( x ) } )
AEval( board_, {| a, x | HB_SYMBOL_UNUSED( a ), drawbox( x ) } )
DO WHILE LastKey() != K_ESC .AND. moremoves()
move := 1
SetColor( 'w/n' )
@@ -103,49 +103,49 @@ FUNCTION FT_PEGS()
READ
IF move > 0
DO CASE
CASE ! board_[move][4]
CASE ! board_[ move ][ 4 ]
err_msg( "No piece there!" )
OTHERWISE
possible_ := {}
FOR xx := 1 TO Len( board_[move][2] )
IF board_[board_[move][2,xx] ][4] .AND. ;
! board_[board_[move][3,xx] ][4]
AAdd( possible_, { board_[move][2,xx], board_[move][3,xx] } )
FOR xx := 1 TO Len( board_[ move ][ 2 ] )
IF board_[ board_[ move ][ 2, xx ] ][ 4 ] .AND. ;
! board_[ board_[ move ][ 3, xx ] ][ 4 ]
AAdd( possible_, { board_[ move ][ 2, xx ], board_[ move ][ 3, xx ] } )
ENDIF
NEXT
// only one available move -- do it
DO CASE
CASE Len( possible_ ) == 1
// clear out original position and the position you jumped over
board_[move][4] := board_[possible_[1, 1] ][4] := .F.
board_[possible_[1, 2] ][4] := .T.
board_[ move ][ 4 ] := board_[ possible_[ 1, 1 ] ][ 4 ] := .F.
board_[ possible_[ 1, 2 ] ][ 4 ] := .T.
drawbox( move, board_[move] )
drawbox( possible_[1,1] )
drawbox( possible_[1,2] )
drawbox( possible_[ 1, 1 ] )
drawbox( possible_[ 1, 2 ] )
CASE Len( possible_ ) == 0
err_msg( 'Illegal move!' )
OTHERWISE
move2 := possible_[1, 2]
move2 := possible_[ 1, 2 ]
toprow := 21 - Len( possible_ )
SetColor( '+w/b' )
buffer := SaveScreen( toprow, 55, 22, 74 )
DOUBLEBOX( toprow, 55, 22, 74 )
@ toprow, 58 SAY 'Possible Moves'
DevPos( toprow, 65 )
AEval( possible_, { | a | DevPos( Row() + 1, 65 ), ;
DevOutPict( a[2], '##' ) } )
AEval( possible_, {| a | DevPos( Row() + 1, 65 ), ;
DevOutPict( a[ 2 ], '##' ) } )
oldscore := Set( _SET_SCOREBOARD, .F. )
@23, 44 GET move2 PICTURE '##' ;
VALID AScan( possible_, scanblock ) > 0
READ
RestScreen( toprow, 55, 22, 74, buffer )
SET( _SET_SCOREBOARD, oldscore )
mpos := AScan( possible_, { | a | move2 == a[2] } )
Set( _SET_SCOREBOARD, oldscore )
mpos := AScan( possible_, {| a | move2 == a[ 2 ] } )
// clear out original position and the position you jumped over
board_[move][4] := board_[possible_[mpos, 1] ][4] := .F.
board_[move2][4] := .T.
board_[ move ][ 4 ] := board_[ possible_[ mpos, 1 ] ][ 4 ] := .F.
board_[ move2 ][ 4 ] := .T.
drawbox( move )
drawbox( possible_[mpos,1] )
drawbox( possible_[ mpos, 1 ] )
drawbox( move2 )
ENDCASE
@@ -158,7 +158,6 @@ FUNCTION FT_PEGS()
RETURN NIL
// end function FT_PEGS()
//--------------------------------------------------------------------*
STATIC FUNCTION DrawBox( nelement )
@@ -171,7 +170,6 @@ STATIC FUNCTION DrawBox( nelement )
RETURN NIL
// end static function DrawBox()
//--------------------------------------------------------------------*
STATIC FUNCTION err_msg( msg )
@@ -187,7 +185,6 @@ STATIC FUNCTION err_msg( msg )
RETURN nil
// end static function Err_Msg()
//--------------------------------------------------------------------*
STATIC FUNCTION moremoves()
@@ -220,5 +217,4 @@ STATIC FUNCTION moremoves()
RETURN canmove
// end static function MoreMoves()
//--------------------------------------------------------------------*

153
harbour/contrib/hbnf/popadder.prg
View File

@@ -62,20 +62,20 @@
#define K_MULTIPLY 42
#define K_DIVIDE 47
#define K_ZERO 48
#define B_DOUBLE "╔═╗║╝═╚║ "
#define B_SINGLE "+-+|+-+| "
#define B_DOUBLE hb_UTF8ToStr( "╔═╗║╝═╚║ " )
#define B_SINGLE "+-+|+-+| "
#define CRLF CHR(13)+CHR(10)
#define nTotTran LEN(aTrans)
#define CRLF Chr( 13 ) + Chr( 10 )
#define nTotTran LEN( aTrans )
#command DISPMESSAGE <mess>,<t>,<l>,<b>,<r> => ;
_ftPushKeys(); KEYBOARD Chr( K_CTRL_PGDN ) + Chr( K_CTRL_W ) ;;
MemoEdit( < mess > , < t > , < l > , < b > , < r > , .F. , NIL, ( < r > ) - ( < l > ) + 1 ) ;;
_ftPopKeys()
#define ASHRINK(ar) ASIZE(ar,LEN(ar)-1)
#define ASHRINK( ar ) ASIZE( ar, LEN( ar ) - 1 )
/* This INKEY UDC was posted by Don Caton on NanForum... Thanks Don <g> */
/* This INKEY UDC was posted by Don Caton on NanForum... Thanks Don <g> */
#command FT_INKEY [ <secs> ] TO <var> ;
=> ;
WHILE .T. ;;
@@ -91,29 +91,29 @@
// and passing aAdder[] all over the place.... Don't let this confuse
// you. I wrote the Adder using the variable names & now let the
// PreProcessor do all the work.
#define nTotal aAdder[1]
#define nNumTotal aAdder[2]
#define nSavTotal aAdder[3]
#define cTotPict aAdder[4]
#define lClAdder aAdder[5]
#define lDecSet aAdder[6]
#define nDecDigit aAdder[7]
#define nMaxDeci aAdder[8]
#define lMultDiv aAdder[9]
#define nAddMode aAdder[10]
#define lSubRtn aAdder[11]
#define lTotalOk aAdder[12]
#define lAddError aAdder[13]
#define lTape aAdder[14]
#define lNewNum aAdder[15]
#define nSavSubTot aAdder[16]
#define lDivError aAdder[17]
#define aTrans aAdder[18]
#define nTopOS aAdder[19]
#define nLeftOS aAdder[20]
#define nAddSpace aAdder[21]
#define nTapeSpace aAdder[22]
#define cTapeScr aAdder[23]
#define nTotal aAdder[ 1 ]
#define nNumTotal aAdder[ 2 ]
#define nSavTotal aAdder[ 3 ]
#define cTotPict aAdder[ 4 ]
#define lClAdder aAdder[ 5 ]
#define lDecSet aAdder[ 6 ]
#define nDecDigit aAdder[ 7 ]
#define nMaxDeci aAdder[ 8 ]
#define lMultDiv aAdder[ 9 ]
#define nAddMode aAdder[ 10 ]
#define lSubRtn aAdder[ 11 ]
#define lTotalOk aAdder[ 12 ]
#define lAddError aAdder[ 13 ]
#define lTape aAdder[ 14 ]
#define lNewNum aAdder[ 15 ]
#define nSavSubTot aAdder[ 16 ]
#define lDivError aAdder[ 17 ]
#define aTrans aAdder[ 18 ]
#define nTopOS aAdder[ 19 ]
#define nLeftOS aAdder[ 20 ]
#define nAddSpace aAdder[ 21 ]
#define nTapeSpace aAdder[ 22 ]
#define cTapeScr aAdder[ 23 ]
// I still use a few of STATICS, but most are set to NIL when quiting...
THREAD STATIC lAdderOpen := .F.
@@ -247,7 +247,7 @@ FUNCTION FT_Adder()
CASE nKey == K_RETURN // <RTN> Total or Subtotal
_ftAddTotal( aAdder )
CASE nKey == K_ESC // <ESC> Quit
SET( _SET_DECIMALS, nOldDecim )
Set( _SET_DECIMALS, nOldDecim )
SetCursor( nOldCurs )
IF lTape
RestScreen( 4 + nTopOS, 6 + nTapeSpace, 22 + nTopOS, 35 + nTapeSpace, cTapeScr )
@@ -320,7 +320,7 @@ FUNCTION FT_Adder()
CASE nKey == K_F10 // <F10> Quit - Return total
IF lTotalOk // Did they finish the calculation
IF oGet != NIL .AND. oGet:TYPE == "N"
SET( _SET_DECIMALS, nOldDecim )
Set( _SET_DECIMALS, nOldDecim )
SetCursor( nOldCurs )
IF lTape
RestScreen( 4 + nTopOS, 6 + nTapeSpace, 22 + nTopOS, 35 + nTapeSpace, cTapeScr )
@@ -433,7 +433,7 @@ STATIC FUNCTION _ftChangeDec( aAdder, nNumDec )
nNumDec := 0
nNumDec := _ftQuest( "How many decimals do you want to display?", ;
nNumDec, "9", {|oGet| _ftValDeci( oGet ) } )
nNumDec, "9", {| oGet | _ftValDeci( oGet ) } )
cTotPict := _ftPosRepl( cDefTotPict, ".", 19 - Abs( nNumDec ) )
@@ -469,8 +469,8 @@ STATIC FUNCTION _ftDispTotal( aAdder )
LOCAL cTotStr
IF nTotal > Val( _ftCharRem( ",",cTotPict ) )
cTotStr := _ftStuffComma( LTrim( Str(nTotal ) ) )
IF nTotal > Val( _ftCharRem( ",", cTotPict ) )
cTotStr := _ftStuffComma( LTrim( Str( nTotal ) ) )
@ 4 + nTopOS, 8 + nAddSpace SAY "**** ERROR **** "
_ftError( "that number is to big to display! I believe the answer was " + ;
cTotStr + "." )
@@ -503,8 +503,8 @@ STATIC FUNCTION _ftDispSubTot( aAdder )
LOCAL cStotStr
IF nNumTotal > Val( _ftCharRem( ",",cTotPict ) )
cStotStr := _ftStuffComma( LTrim( Str(nNumTotal ) ) )
IF nNumTotal > Val( _ftCharRem( ",", cTotPict ) )
cStotStr := _ftStuffComma( LTrim( Str( nNumTotal ) ) )
@ 4 + nTopOS, 8 + nAddSpace SAY "**** ERROR **** "
_ftError( "that number is to big to display! I believe the answer was " + ;
cStotStr + "." )
@@ -598,11 +598,11 @@ STATIC FUNCTION _ftAddTotal( aAdder )
lTotalOk := .T.
ENDIF
ELSE // This was the first time they pressed
IF !lMultDiv .AND. LastKey() == K_RETURN // total key
IF ! lMultDiv .AND. LastKey() == K_RETURN // total key
lSubRtn := .T.
ENDIF
IF _ftRoundIt( nTotal, nMaxDeci ) != 0 .OR. _ftRoundIt( nNumTotal, nMaxDeci ) != 0
IF !lMultDiv
IF ! lMultDiv
_ftSetWinColor( W_CURR, W_SCREEN )
@ 6 + nTopOS, 18 + nAddSpace SAY "<SUBTOTAL>"
_ftSetWinColor( W_CURR, W_PROMPT )
@@ -634,7 +634,7 @@ STATIC FUNCTION _ftAddTotal( aAdder )
@ 6 + nTopOS, 18 + nAddSpace SAY " <TOTAL>"
_ftSetWinColor( W_CURR, W_PROMPT )
lSubRtn := .F. // pressed total so key reset everything
IF !lTotalOk // If you haven't printed total DO-IT
IF ! lTotalOk // If you haven't printed total DO-IT
lTotalOk := .T.
_ftUpdateTrans( aAdder, .F. , NIL )
ENDIF
@@ -642,7 +642,7 @@ STATIC FUNCTION _ftAddTotal( aAdder )
nSavTotal := nTotal
nTotal := 0
ELSE
IF !lTotalOk // If you haven't printed total DO-IT
IF ! lTotalOk // If you haven't printed total DO-IT
_ftUpdateTrans( aAdder, .F. , NIL )
nNumTotal := 0
ENDIF
@@ -792,7 +792,7 @@ STATIC FUNCTION _ftAddHelp
" <M>ove - the Adder from right to left" + CRLF + ;
" <T>ape - turn Tape Display On or Off" + CRLF + ;
" <S>croll - the tape display" + CRLF + CRLF + ;
" <DEL> ---┬-- 1st Clear entry" + CRLF + ;
" <DEL> ---+-- 1st Clear entry" + CRLF + ;
" +-- 2nd Clear ADDER" + CRLF + ;
" <ESC> - Quit" + CRLF + ;
" <F10> - return a <TOTAL> to the active get"
@@ -855,24 +855,24 @@ STATIC FUNCTION _ftUpdateTrans( aAdder, lTypeTotal, nAmount )
nAmount := iif( nAmount == NIL, 0, nAmount )
IF lClAdder // Clear the adder (they pressed <DEL> twice
AAdd( aTrans, Str( 0,22,nMaxDeci ) + " C" )
AAdd( aTrans, Str( 0, 22, nMaxDeci ) + " C" )
IF lTape // If there is a tape Show Clear
_ftDisplayTape( aAdder )
ENDIF
RETU NIL
ENDIF
IF lTypeTotal // If lTypeTotal=.T. Update from total
AAdd( aTrans, Str( iif(lUseTotal,nTotal,nAmount ),22,nMaxDeci ) )
aTrans[nTotTran] := _ftStuffComma( aTrans[nTotTran], .T. ) + " *" + ;
IF lTypeTotal // If lTypeTotal == .T. Update from total
AAdd( aTrans, Str( iif( lUseTotal, nTotal, nAmount ), 22, nMaxDeci ) )
aTrans[ nTotTran ] := _ftStuffComma( aTrans[ nTotTran ], .T. ) + " *" + ;
iif( lAddError, "ER", "" )
ELSE // If lTypeTotal=.F. Update from nNumTotal
AAdd( aTrans, Str( iif(lUseTotal,nTotal,nAmount ),22,nMaxDeci ) )
AAdd( aTrans, Str( iif( lUseTotal, nTotal, nAmount ), 22, nMaxDeci ) )
aTrans[nTotTran] := _ftStuffComma( aTrans[nTotTran], .T. ) + ;
iif( lSubRtn, " S", iif( nAddMode == 1," +",iif(nAddMode == 2," -",IF ;
( lTotalOk, " =", iif( nAddMode == 3," X"," /" ) ) ) ) ) + iif( lAddError, "ER", "" )
aTrans[ nTotTran ] := _ftStuffComma( aTrans[ nTotTran ], .T. ) + ;
iif( lSubRtn, " S", iif( nAddMode == 1, " +", iif( nAddMode == 2, " -", ;
iif( lTotalOk, " =", iif( nAddMode == 3, " X", " /" ) ) ) ) ) + iif( lAddError, "ER", "" )
ENDIF
@@ -996,13 +996,13 @@ STATIC FUNCTION _ftDisplayTape( aAdder, nKey )
IF ( nKey == 84 .OR. nKey == 116 ) .AND. lTape // Stop displaying tape
lTape := .F.
RestScreen( 4 + nTopOS, 6 + nTapeSpace, 22 + nTopOS, 35 + nTapeSpace, cTapeScr )
RETU NIL
RETURN NIL
ENDIF
IF lTape // Are we in the display mode
SetColor( "N/W" )
Scroll( 5 + nTopOS, 7 + nTapeSpace, 20 + nTopOS, 32 + nTapeSpace, 1 )
IF nTotTran > 0 // Any transactions been entered yet?
@ 20 + nTopOS, 7 + nTapeSpace SAY aTrans[nTotTran]
@ 20 + nTopOS, 7 + nTapeSpace SAY aTrans[ nTotTran ]
ENDIF
_ftSetWinColor( W_CURR, W_PROMPT )
ELSE // Start displaying tape
@@ -1020,7 +1020,7 @@ STATIC FUNCTION _ftDisplayTape( aAdder, nKey )
nTopTape := nTotTran - 15
ENDIF
FOR nDispTape := nTotTran TO nTopTape STEP - 1
@ 20 + nDispTape - nTotTran + nTopOS, 7 + nTapeSpace SAY aTrans[nDispTape]
@ 20 + nDispTape - nTotTran + nTopOS, 7 + nTapeSpace SAY aTrans[ nDispTape ]
NEXT
ENDIF
_ftSetWinColor( W_CURR, W_PROMPT )
@@ -1092,7 +1092,7 @@ STATIC FUNCTION _ftPopKeys
LOCAL cKeys := ""
IF Len( aKeys ) != 0
AEval( aKeys, {|elem| cKeys += Chr( elem ) } )
AEval( aKeys, {| elem | cKeys += Chr( elem ) } )
ENDIF
KEYBOARD cKeys
aKeys := {}
@@ -1132,7 +1132,7 @@ STATIC FUNCTION _ftPushMessage( cMessage, lWait, cTitle, cBotTitle, xQuiet, nTop
cOldDevic := Set( _SET_DEVICE, "SCREEN" )
lOldPrint := Set( _SET_PRINTER, .F. )
nMessLen := Len( cMessage )
nWide := iif( nMessLen > 72, 72, iif( nMessLen < 12,12,nMessLen ) )
nWide := iif( nMessLen > 72, 72, iif( nMessLen < 12, 12, nMessLen ) )
nNumRows := MLCount( cMessage, nWide )
// If they didn't say what the top row is, Center it on the screen
@@ -1157,8 +1157,8 @@ STATIC FUNCTION _ftPushMessage( cMessage, lWait, cTitle, cBotTitle, xQuiet, nTop
SetCursor( nOldCurs )
SetColor( cOldColor )
SetPos( nOldRow, nOldCol )
SET( _SET_DEVICE, cOldDevic )
SET( _SET_PRINTER, lOldPrint )
Set( _SET_DEVICE, cOldDevic )
Set( _SET_PRINTER, lOldPrint )
_ftSetLastKey( nOldLastKey )
RETURN NIL
@@ -1209,7 +1209,7 @@ STATIC FUNCTION _ftQuest( cMessage, xVarVal, cPict, bValid, lNoESC, nWinColor, n
LOCAL nRight, oNewGet, nNumMessRow, nLenLastRow, lGetOnNextLine, nOldCurs
LOCAL cVarType := ValType( xVarVal )
LOCAL nVarLen := iif( cVarType == "C", Len( xVarVal ), iif( cVarType == "D", 8, ;
iif( cVarType == "L", 1, iif( cVarType == "N", iif(cPict == NIL, 9, ;
iif( cVarType == "L", 1, iif( cVarType == "N", iif( cPict == NIL, 9, ;
Len( cPict ) ), 0 ) ) ) )
LOCAL nOldLastKey := LastKey()
LOCAL cOldDevice := Set( _SET_DEVICE, "SCREEN" )
@@ -1219,13 +1219,13 @@ STATIC FUNCTION _ftQuest( cMessage, xVarVal, cPict, bValid, lNoESC, nWinColor, n
nOldCol := Col()
nOldCurs := SetCursor( SC_NONE )
cOldColor := SetColor()
lNoESC := iif( lNoESC == NIL, .F. , lNoESC )
lNoESC := iif( lNoESC == NIL, .F., lNoESC )
nMessLen := Len( cMessage ) + nVarLen + 1
nWide := iif( nMessLen > 66, 66, iif( nMessLen < 12,12,nMessLen ) )
nWide := iif( nMessLen > 66, 66, iif( nMessLen < 12, 12, nMessLen ) )
nNumMessRow := MLCount( cMessage, nWide )
nLenLastRow := Len( Trim( MemoLine(cMessage,nWide,nNumMessRow ) ) )
nLenLastRow := Len( Trim( MemoLine( cMessage, nWide, nNumMessRow ) ) )
lGetOnNextLine := ( nLenLastRow + nVarLen ) > nWide
nNumRows := nNumMessRow + iif( lGetOnNextLine, 1, 0 )
@@ -1246,7 +1246,7 @@ STATIC FUNCTION _ftQuest( cMessage, xVarVal, cPict, bValid, lNoESC, nWinColor, n
// If the input line is character & wider than window SCROLL
IF lGetOnNextLine .AND. HB_ISSTRING( xVarVal ) .AND. nVarLen > nWide
oNewGet:Picture := "@S" + LTrim( Str( nWide,4,0 ) ) + iif( cPict == NIL, "", " " + cPict )
oNewGet:Picture := "@S" + LTrim( Str( nWide, 4, 0 ) ) + iif( cPict == NIL, "", " " + cPict )
ENDIF
IF cPict != NIL // Use the picture they passed
@@ -1282,8 +1282,8 @@ STATIC FUNCTION _ftQuest( cMessage, xVarVal, cPict, bValid, lNoESC, nWinColor, n
SetCursor( nOldCurs )
SetColor( cOldColor )
SetPos( nOldRow, nOldCol )
SET( _SET_DEVICE, cOldDevice )
SET( _SET_PRINTER, lOldPrint )
Set( _SET_DEVICE, cOldDevice )
Set( _SET_PRINTER, lOldPrint )
_ftSetLastKey( nOldLastKey )
RETURN xVarVal
@@ -1389,8 +1389,8 @@ STATIC FUNCTION _ftError( cMessage, xDontReset )
_ftSetLastKey( nOldLastKey )
ENDIF
SET( _SET_DEVICE, cOldDevic )
SET( _SET_PRINTER, lOldPrint )
Set( _SET_DEVICE, cOldDevic )
Set( _SET_PRINTER, lOldPrint )
RETURN NIL
@@ -1720,22 +1720,23 @@ STATIC FUNCTION _ftWinTitle( cTheTitle, cTopOrBot )
STATIC FUNCTION _ftInitColors
aWinColor := { { "GR+/BG","GR+/G", "B+/RB", "G+/R" } , ;
{ "R+/N", "W+/RB", "W+/BG", "GR+/B" } , ;
{ "GR+/N", "GR+/N", "GR+/N", "GR+/N" } , ;
{ "B/BG", "BG+/G", "W+/RB", "BG+/R" } , ;
aWinColor := { ;
{ "GR+/BG","GR+/G", "B+/RB", "G+/R" } , ;
{ "R+/N", "W+/RB", "W+/BG", "GR+/B" } , ;
{ "GR+/N", "GR+/N", "GR+/N", "GR+/N" } , ;
{ "B/BG", "BG+/G", "W+/RB", "BG+/R" } , ;
{ "W+/BG", "W+/G", "GR+/RB", "W+/R" } , ;
{ "GR+/B", "GR+/R", "R+/B", "W+/BG" }, ;
{ "N/N", "N/N", "N/N", "N/N" } }
aStdColor := { "BG+*/RB" , ;
"GR+/R" , ;
"GR+/N" , ;
"W/B" , ;
"GR+/N" , ;
"GR+/GR" , ;
aStdColor := { "BG+*/RB" , ;
"GR+/R" , ;
"GR+/N" , ;
"W/B" , ;
"GR+/N" , ;
"GR+/GR" , ;
{ "W+/B", "W/B", "G+/B", "R+/B", ;
"GR+/B", "BG+/B", "B+/B", "G+/B" }, ;
"GR+/B", "BG+/B", "B+/B", "G+/B" }, ;
"N/N" }
RETURN NIL

2
harbour/contrib/hbnf/prtesc.prg
View File

@@ -61,7 +61,7 @@ FUNCTION FT_ESCCODE( cInput )
IsDigit( SubStr( cInput, nPointer + 1, 1 ) ) .AND. ;
IsDigit( SubStr( cInput, nPointer + 2, 1 ) ) .AND. ;
IsDigit( SubStr( cInput, nPointer + 3, 1 ) )
cOutput += Chr( Val( SubStr(cInput, nPointer + 1, 3 ) ) )
cOutput += Chr( Val( SubStr( cInput, nPointer + 1, 3 ) ) )
nPointer += 4
CASE cCurrent == "\" .AND. ;

2
harbour/contrib/hbnf/pvid.prg
View File

@@ -57,7 +57,7 @@ FUNCTION FT_PopVid()
IF nNewSize >= 0
SetMode( aBottom[ PV_MAXROW ], aBottom[ PV_MAXCOL ] )
SET( _SET_CURSOR, aBottom[ PV_CURSOR ] )
Set( _SET_CURSOR, aBottom[ PV_CURSOR ] )
NoSnow( aBottom[ PV_NOSNOW ] )
SetBlink( aBottom[ PV_BLINK ] )
RestScreen( 0, 0, MaxRow(), MaxCol(), aBottom[ PV_IMAGE ] )

4
harbour/contrib/hbnf/savearr.prg
View File

@@ -71,7 +71,7 @@ FUNCTION DispArray( aTest )
?? iif( aTest[ nk, 4 ], 'true', 'false' )
NEXT
RETURN Nil
RETURN NIL
#endif
@@ -108,7 +108,7 @@ STATIC FUNCTION _ftsavesub( xMemVar, nHandle, nErrorCode )
nLen := Len( xMemVar )
FWrite( nHandle, L2Bin( nLen ), 4 )
IF FError() == 0
AEval( xMemVar, {|xMemVar1| lRet := _ftsavesub( xMemVar1, nHandle ) } )
AEval( xMemVar, {| xMemVar1 | lRet := _ftsavesub( xMemVar1, nHandle ) } )
ELSE
lRet := .F.
ENDIF

6
harbour/contrib/hbnf/scregion.prg
View File

@@ -34,11 +34,11 @@ FUNCTION FT_SAVRGN( nTop, nLeft, nBottom, nRight )
FUNCTION FT_RSTRGN( cScreen, nTop, nLeft )
IF PCount() == 3
RestScreen( nTop, nLeft, ( nTop - Asc(cScreen ) ) + Asc( SubStr(cScreen, 3 ) ), ;
( nLeft - Asc( SubStr(cScreen, 2 ) ) ) + Asc( SubStr( cScreen, 4 ) ), ;
RestScreen( nTop, nLeft, ( nTop - Asc(cScreen ) ) + Asc( SubStr( cScreen, 3 ) ), ;
( nLeft - Asc( SubStr( cScreen, 2 ) ) ) + Asc( SubStr( cScreen, 4 ) ), ;
SubStr( cScreen, 5 ) )
ELSE
RestScreen( Asc( cScreen ), Asc( SubStr(cScreen, 2 ) ), Asc( SubStr(cScreen, 3 ) ), ;
RestScreen( Asc( cScreen ), Asc( SubStr( cScreen, 2 ) ), Asc( SubStr( cScreen, 3 ) ), ;
Asc( SubStr( cScreen, 4 ) ), SubStr( cScreen, 5 ) )
ENDIF

4
harbour/contrib/hbnf/sqzn.prg
View File

@@ -34,7 +34,7 @@ FUNCTION ft_sqzn( nValue, nSize, nDecimals )
cCompressed := Chr( Val( SubStr( tmpstr, 1, 2 ) ) + iif( nValue < 0, 128, 0 ) )
FOR k := 3 TO Len( tmpstr ) STEP 2
cCompressed += Chr( Val( SubStr(tmpstr, k, 2 ) ) )
cCompressed += Chr( Val( SubStr( tmpstr, k, 2 ) ) )
NEXT
RETURN cCompressed
@@ -45,7 +45,7 @@ FUNCTION ft_unsqzn( cCompressed, nSize, nDecimals )
nSize := iif( nSize == NIL, 10, nSize )
nDecimals := iif( nDecimals == NIL, 0, nDecimals )
cCompressed := iif( multi == - 1, SubStr( cCompressed, 2 ), cCompressed )
cCompressed := iif( multi == - 1, SubStr( cCompressed, 2 ), cCompressed )
nSize := iif( nSize / 2 != Int( nSize / 2 ), nSize + 1, nSize )
IF Asc( cCompressed ) > 127
tmp := Str( Asc( cCompressed ) - 128, 2 )

2
harbour/contrib/hbnf/tempfile.prg
View File

@@ -60,7 +60,7 @@
FUNCTION FT_TEMPFIL( cPath, lHide, nHandle )
LOCAL cRet, aRegs[3]
LOCAL cRet, aRegs[ 3 ]
cPath := iif( ! HB_ISSTRING( cPath ), ;
Replicate( Chr( 0 ), 13 ) , ;

39
harbour/contrib/hbnf/vertmenu.prg
View File

@@ -28,28 +28,31 @@
PROCEDURE Main()
LOCAL MAINMENU := ;
{ { "DATA ENTRY", "ENTER DATA", { || FT_MENU2( datamenu) } }, ;
{ "Reports", "Hard copy", { || FT_MENU2( repmenu ) } }, ;
{ "Maintenance", "Reindex files, etc.", { || FT_MENU2( maintmenu ) } }, ;
{ "Quit", "See ya later" } }
LOCAL MAINMENU := { ;
{ "DATA ENTRY", "ENTER DATA", {|| FT_MENU2( datamenu ) } }, ;
{ "Reports", "Hard copy", {|| FT_MENU2( repmenu ) } }, ;
{ "Maintenance", "Reindex files, etc.", {|| FT_MENU2( maintmenu ) } }, ;
{ "Quit", "See ya later" } }
LOCAL datamenu := { { "Customers", , { || cust() } } , ;
{ "Invoices", , { || inv() } } , ;
{ "Vendors", , { || vendors() } }, ;
LOCAL datamenu := { ;
{ "Customers", , {|| cust() } } , ;
{ "Invoices", , {|| inv() } } , ;
{ "Vendors", , {|| vendors() } }, ;
{ "Exit", "Return to Main Menu" } }
LOCAL repmenu := { { "Customer List", , { || custrep() } } , ;
{ "Past Due", , { || pastdue() } } , ;
{ "Weekly Sales", , { || weeksales() } }, ;
{ "Monthly P&L", , { || monthpl() } } , ;
{ "Vendor List", , { || vendorrep() } }, ;
LOCAL repmenu := { ;
{ "Customer List", , {|| custrep() } } , ;
{ "Past Due", , {|| pastdue() } } , ;
{ "Weekly Sales", , {|| weeksales() } }, ;
{ "Monthly P&L", , {|| monthpl() } } , ;
{ "Vendor List", , {|| vendorrep() } }, ;
{ "Exit", "Return to Main Menu" } }
LOCAL maintmenu := { { "Reindex", "Rebuild index files", { || re_ntx() } } , ;
{ "Backup", "Backup data files" , { || backup() } } , ;
{ "Compress", "Compress data files", { || compress() } }, ;
{ "Exit", "Return to Main Menu" } }
LOCAL maintmenu := { ;
{ "Reindex", "Rebuild index files", {|| re_ntx() } } , ;
{ "Backup", "Backup data files" , {|| backup() } } , ;
{ "Compress", "Compress data files", {|| compress() } }, ;
{ "Exit", "Return to Main Menu" } }
FT_MENU2( mainmenu )
@@ -99,7 +102,7 @@ FUNCTION ft_menu2( aMenuInfo, cColors )
ENDIF
/* determine longest menu option */
AEval( aMenuInfo, { | ele | nMaxwidth := Max( nMaxwidth, Len( ele[1] ) ) } )
AEval( aMenuInfo, {| ele | nMaxwidth := Max( nMaxwidth, Len( ele[ 1 ] ) ) } )
/* establish top and left box coordinates */
nLeft := ( ( MaxCol() + 1 ) - nMaxwidth ) / 2