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

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

Browse Source 
* contrib/hbnf/acctadj.prg
  * contrib/hbnf/acctmnth.prg
  * contrib/hbnf/acctqtr.prg
  * contrib/hbnf/acctweek.prg
  * contrib/hbnf/aemaxlen.prg
  * contrib/hbnf/aeminlen.prg
  * contrib/hbnf/amedian.prg
  * contrib/hbnf/at2.prg
  * contrib/hbnf/calendar.prg
  * contrib/hbnf/clrsel.prg
  * contrib/hbnf/d2e.prg
  * contrib/hbnf/datecnfg.prg
  * contrib/hbnf/dayofyr.prg
  * contrib/hbnf/dfile.prg
  * contrib/hbnf/dispmsg.prg
  * contrib/hbnf/e2d.prg
  * contrib/hbnf/elapsed.prg
  * contrib/hbnf/floptst.prg
  * contrib/hbnf/linked.prg
  * contrib/hbnf/menu1.prg
  * contrib/hbnf/month.prg
  * contrib/hbnf/pchr.prg
  * contrib/hbnf/pegs.prg
  * contrib/hbnf/pending.prg
  * contrib/hbnf/popadder.prg
  * contrib/hbnf/qtr.prg
  * contrib/hbnf/savearr.prg
  * contrib/hbnf/tbwhile.prg
  * contrib/hbnf/tempfile.prg
  * contrib/hbnf/week.prg
  * contrib/hbnf/pickday.prg
  * contrib/hbnf/vertmenu.prg
    ! avoid box.ch for unicode compatibility
    * ' -> "
    * minor formatting
    * avoided a few STATICs
    ! FT_ACCTADJ() fixed second parameter handling to be in sync
      with docs and logic
This commit is contained in:
Viktor Szakats
2012-09-26 14:31:56 +00:00
parent 87dca087d1
commit 88676aaf35
33 changed files with 288 additions and 252 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
harbour/ChangeLog
View File

@@ -16,6 +16,46 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-09-26 16:29 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbnf/acctadj.prg
* contrib/hbnf/acctmnth.prg
* contrib/hbnf/acctqtr.prg
* contrib/hbnf/acctweek.prg
* contrib/hbnf/aemaxlen.prg
* contrib/hbnf/aeminlen.prg
* contrib/hbnf/amedian.prg
* contrib/hbnf/at2.prg
* contrib/hbnf/calendar.prg
* contrib/hbnf/clrsel.prg
* contrib/hbnf/d2e.prg
* contrib/hbnf/datecnfg.prg
* contrib/hbnf/dayofyr.prg
* contrib/hbnf/dfile.prg
* contrib/hbnf/dispmsg.prg
* contrib/hbnf/e2d.prg
* contrib/hbnf/elapsed.prg
* contrib/hbnf/floptst.prg
* contrib/hbnf/linked.prg
* contrib/hbnf/menu1.prg
* contrib/hbnf/month.prg
* contrib/hbnf/pchr.prg
* contrib/hbnf/pegs.prg
* contrib/hbnf/pending.prg
* contrib/hbnf/popadder.prg
* contrib/hbnf/qtr.prg
* contrib/hbnf/savearr.prg
* contrib/hbnf/tbwhile.prg
* contrib/hbnf/tempfile.prg
* contrib/hbnf/week.prg
* contrib/hbnf/pickday.prg
* contrib/hbnf/vertmenu.prg
! avoid box.ch for unicode compatibility
* ' -> "
* minor formatting
* avoided a few STATICs
! FT_ACCTADJ() fixed second parameter handling to be in sync
with docs and logic
2012-09-26 13:29 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbnf/aavg.prg
* contrib/hbnf/adessort.prg

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

@@ -39,7 +39,7 @@ FUNCTION FT_ACCTADJ( dGivenDate, lIsEnd )
dGivenDate := Date()
ENDIF
lIsEnd := HB_ISLOGICAL( lIsEnd ) // TOFIX: Is this intended?
lIsEnd := iif( HB_ISLOGICAL( lIsEnd ), lIsEnd, .F. )
nTemp := FT_DAYTOBOW( dGivenDate )
IF nTemp > ( 2 + iif( lIsEnd, 0, 1 ) )

34
harbour/contrib/hbnf/acctmnth.prg
View File

@@ -31,7 +31,7 @@ FUNCTION FT_ACCTMONTH( dGivenDate, nMonthNum )
LOCAL nYTemp, nMTemp, lIsMonth, aRetVal
IF ! ( ValType( dGivenDate ) $ 'ND' )
IF ! ( ValType( dGivenDate ) $ "ND" )
dGivenDate := Date()
ELSEIF HB_ISNUMERIC( dGivenDate )
nMonthNum := dGivenDate
@@ -39,12 +39,12 @@ FUNCTION FT_ACCTMONTH( dGivenDate, nMonthNum )
ENDIF
aRetVal := FT_MONTH( dGivenDate )
nYTemp := Val( SubStr( aRetVal[1],1,4 ) )
nMTemp := Val( SubStr( aRetVal[1],5,2 ) )
aRetVal[2] := FT_ACCTADJ( aRetVal[2] )
aRetVal[3] := FT_ACCTADJ( aRetVal[3], .T. )
nYTemp := Val( SubStr( aRetVal[ 1 ], 1, 4 ) )
nMTemp := Val( SubStr( aRetVal[ 1 ], 5, 2 ) )
aRetVal[ 2 ] := FT_ACCTADJ( aRetVal[ 2 ] )
aRetVal[ 3 ] := FT_ACCTADJ( aRetVal[ 3 ], .T. )
IF dGivenDate < aRetVal[2]
IF dGivenDate < aRetVal[ 2 ]
dGivenDate := FT_MADD( dGivenDate, - 1 )
aRetVal := FT_MONTH( dGivenDate )
nMTemp -= 1
@@ -52,10 +52,10 @@ FUNCTION FT_ACCTMONTH( dGivenDate, nMonthNum )
nYTemp -= 1
nMTemp := 12
ENDIF
aRetVal[2] := FT_ACCTADJ( aRetVal[2] )
aRetVal[3] := FT_ACCTADJ( aRetVal[3], .T. )
aRetVal[ 2 ] := FT_ACCTADJ( aRetVal[ 2 ] )
aRetVal[ 3 ] := FT_ACCTADJ( aRetVal[ 3 ], .T. )
ELSEIF dGivenDate > aRetVal[3]
ELSEIF dGivenDate > aRetVal[ 3 ]
dGivenDate := FT_MADD( dGivenDate, 1 )
aRetVal := FT_MONTH( dGivenDate )
@@ -64,8 +64,8 @@ FUNCTION FT_ACCTMONTH( dGivenDate, nMonthNum )
nYTemp += 1
nMTemp := 1
ENDIF
aRetVal[2] := FT_ACCTADJ( aRetVal[2] )
aRetVal[3] := FT_ACCTADJ( aRetVal[3], .T. )
aRetVal[ 2 ] := FT_ACCTADJ( aRetVal[ 2 ] )
aRetVal[ 3 ] := FT_ACCTADJ( aRetVal[ 3 ], .T. )
ENDIF
@@ -74,13 +74,13 @@ FUNCTION FT_ACCTMONTH( dGivenDate, nMonthNum )
IF nMonthNum < 1 .OR. nMonthNum > 12
nMonthNum := 12
ENDIF
aRetVal := FT_MONTH( dGivenDate, nMonthNum )
nYTemp := Val( SubStr( aRetVal[1],1,4 ) )
nMTemp := Val( SubStr( aRetVal[1],5,2 ) )
aRetVal[2] := FT_ACCTADJ( aRetVal[2] )
aRetVal[3] := FT_ACCTADJ( aRetVal[3], .T. )
aRetVal := FT_MONTH( dGivenDate, nMonthNum )
nYTemp := Val( SubStr( aRetVal[ 1 ], 1, 4 ) )
nMTemp := Val( SubStr( aRetVal[ 1 ], 5, 2 ) )
aRetVal[ 2 ] := FT_ACCTADJ( aRetVal[ 2 ] )
aRetVal[ 3 ] := FT_ACCTADJ( aRetVal[ 3 ], .T. )
ENDIF
aRetVal[1] := Str( nYTemp, 4 ) + PadL( LTrim( Str( nMTemp, 2 ) ), 2, '0' )
aRetVal[ 1 ] := Str( nYTemp, 4 ) + PadL( LTrim( Str( nMTemp, 2 ) ), 2, "0" )
RETURN aRetVal

34
harbour/contrib/hbnf/acctqtr.prg
View File

@@ -31,19 +31,19 @@ FUNCTION FT_ACCTQTR( dGivenDate, nQtrNum )
LOCAL nYTemp, nQTemp, lIsQtr, aRetVal
IF ! ( ValType( dGivenDate ) $ 'ND' )
IF ! ( ValType( dGivenDate ) $ "ND" )
dGivenDate := Date()
ELSEIF HB_ISNUMERIC( dGivenDate )
nQtrNum := dGivenDate
dGivenDate := Date()
ENDIF
aRetVal := FT_QTR( dGivenDate )
nYTemp := Val( SubStr( aRetVal[1],1,4 ) )
nQTemp := Val( SubStr( aRetVal[1],5,2 ) )
aRetVal[2] := FT_ACCTADJ( aRetVal[2] )
aRetVal[3] := FT_ACCTADJ( aRetVal[3], .T. )
aRetVal := FT_QTR( dGivenDate )
nYTemp := Val( SubStr( aRetVal[ 1 ], 1, 4 ) )
nQTemp := Val( SubStr( aRetVal[ 1 ], 5, 2 ) )
aRetVal[ 2 ] := FT_ACCTADJ( aRetVal[ 2 ] )
aRetVal[ 3 ] := FT_ACCTADJ( aRetVal[ 3 ], .T. )
IF dGivenDate < aRetVal[2]
IF dGivenDate < aRetVal[ 2 ]
dGivenDate := FT_MADD( dGivenDate, - 1 )
aRetVal := FT_QTR( dGivenDate )
nQTemp -= 1
@@ -51,8 +51,8 @@ FUNCTION FT_ACCTQTR( dGivenDate, nQtrNum )
nYTemp -= 1
nQTemp := 4
ENDIF
aRetVal[2] := FT_ACCTADJ( aRetVal[2] )
aRetVal[3] := FT_ACCTADJ( aRetVal[3], .T. )
aRetVal[ 2 ] := FT_ACCTADJ( aRetVal[ 2 ] )
aRetVal[ 3 ] := FT_ACCTADJ( aRetVal[ 3 ], .T. )
ELSEIF dGivenDate > aRetVal[3]
@@ -63,8 +63,8 @@ FUNCTION FT_ACCTQTR( dGivenDate, nQtrNum )
nYTemp += 1
nQTemp := 1
ENDIF
aRetVal[2] := FT_ACCTADJ( aRetVal[2] )
aRetVal[3] := FT_ACCTADJ( aRetVal[3], .T. )
aRetVal[2] := FT_ACCTADJ( aRetVal[ 2 ] )
aRetVal[3] := FT_ACCTADJ( aRetVal[ 3 ], .T. )
ENDIF
@@ -73,13 +73,13 @@ FUNCTION FT_ACCTQTR( dGivenDate, nQtrNum )
IF nQtrNum < 1 .OR. nQtrNum > 4
nQtrNum := 4
ENDIF
aRetVal := FT_QTR( dGivenDate, nQtrNum )
nYTemp := Val( SubStr( aRetVal[1],1,4 ) )
nQTemp := Val( SubStr( aRetVal[1],5,2 ) )
aRetVal[2] := FT_ACCTADJ( aRetVal[2] )
aRetVal[3] := FT_ACCTADJ( aRetVal[3], .T. )
aRetVal := FT_QTR( dGivenDate, nQtrNum )
nYTemp := Val( SubStr( aRetVal[ 1 ], 1, 4 ) )
nQTemp := Val( SubStr( aRetVal[ 1 ], 5, 2 ) )
aRetVal[ 2 ] := FT_ACCTADJ( aRetVal[ 2 ] )
aRetVal[ 3 ] := FT_ACCTADJ( aRetVal[ 3 ], .T. )
ENDIF
aRetVal[1] := Str( nYTemp, 4 ) + PadL( LTrim( Str( nQTemp, 2 ) ), 2, '0' )
aRetVal[ 1 ] := Str( nYTemp, 4 ) + PadL( LTrim( Str( nQTemp, 2 ) ), 2, "0" )
RETURN aRetVal

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

@@ -31,7 +31,7 @@ FUNCTION FT_ACCTWEEK( dGivenDate, nWeekNum )
LOCAL nTemp, lIsWeek, aRetVal
IF ! ValType( dGivenDate ) $ 'ND'
IF ! ValType( dGivenDate ) $ "ND"
dGivenDate := Date()
ELSEIF HB_ISNUMERIC( dGivenDate )
nWeekNum := dGivenDate
@@ -50,7 +50,7 @@ FUNCTION FT_ACCTWEEK( dGivenDate, nWeekNum )
ENDIF
aRetVal[ 1 ] += PadL( LTrim( Str( Int( ( dGivenDate - ;
aRetVal[ 2 ] ) / 7 ) + 1, 2 ) ), 2, '0' )
aRetVal[ 2 ] ) / 7 ) + 1, 2 ) ), 2, "0" )
dGivenDate += ( 6 - FT_DAYTOBOW( dGivenDate ) ) // end of week
aRetVal[ 2 ] := dGivenDate - 6
aRetVal[ 3 ] := dGivenDate

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

@@ -34,19 +34,19 @@ PROCEDURE Main()
? "myarray1 := DIRECTORY()"
?
var0 := FT_AEMAXLEN( myarray1 )
? PadR( 'FT_AEMAXLEN( myarray1 ) ->', 30 )
? PadR( "FT_AEMAXLEN( myarray1 ) ->", 30 )
?? var0
?
var0 := FT_AEMAXLEN( myarray1, 2 )
? PadR( 'FT_AEMAXLEN( myarray1,2 ) ->', 30 )
? PadR( "FT_AEMAXLEN( myarray1, 2 ) ->", 30 )
?? var0
?
var0 := FT_AEMAXLEN( myarray1, 3 )
? PadR( 'FT_AEMAXLEN( myarray1,3 ) ->', 30 )
? PadR( "FT_AEMAXLEN( myarray1, 3 ) ->", 30 )
?? var0
?
var0 := FT_AEMAXLEN( ATail( myarray1 ) )
? PadR( 'FT_AEMAXLEN( aTail( myarray1 ) ) ->', 30 )
? PadR( "FT_AEMAXLEN( aTail( myarray1 ) ) ->", 30 )
?? var0
?

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

@@ -35,21 +35,21 @@ PROCEDURE Main()
?
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 )
? PadR( "FT_AEMINLEN( myarray1 ) ->", 30 )
?? var0
?
var0 := FT_AEMINLEN( myarray1, 2 )
? PadR( 'FT_AEMINLEN( myarray1,2 ) ->', 30 )
? PadR( "FT_AEMINLEN( myarray1, 2 ) ->", 30 )
?? var0
?
?
var0 := FT_AEMINLEN( myarray1[2] )
? PadR( 'FT_AEMINLEN( myarray1[2] ) ->', 30 )
var0 := FT_AEMINLEN( myarray1[ 2 ] )
? PadR( "FT_AEMINLEN( myarray1[ 2 ] ) ->", 30 )
?? var0
?
?
var0 := FT_AEMINLEN( myarray1, 3 )
? PadR( 'FT_AEMINLEN( myarray1,3 ) ->', 30 )
? PadR( "FT_AEMINLEN( myarray1, 3 ) ->", 30 )
?? var0
?

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

@@ -37,19 +37,19 @@ PROCEDURE Main()
?
AEval( myarray0, {| x | AAdd( myarray1, x[ F_SIZE ] ) } )
var0 := FT_AMEDIAN( myarray1 )
? PadR( 'FT_AMEDIAN( myarray1 ) ->', 35 )
? PadR( "FT_AMEDIAN( myarray1 ) ->", 35 )
?? var0
?
var0 := FT_AMEDIAN( myarray1, 2 )
? PadR( 'FT_AMEDIAN( myarray1, 2 ) ->', 35 )
? PadR( "FT_AMEDIAN( myarray1, 2 ) ->", 35 )
?? var0
?
var0 := FT_AMEDIAN( myarray1, , 9 )
? PadR( 'FT_AMEDIAN( myarray1, , 9 ) ->', 35 )
? PadR( "FT_AMEDIAN( myarray1, , 9 ) ->", 35 )
?? var0
?
var0 := FT_AMEDIAN( myarray1, 8, 40 )
? PadR( 'FT_AMEDIAN( myarray1, 8, 40 ) ->', 35 )
? PadR( "FT_AMEDIAN( myarray1, 8, 40 ) ->", 35 )
?? var0
?

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

@@ -36,7 +36,7 @@ PROCEDURE Main()
CLS
? "TEST TO DEMONSTRATE EXAMPLES OF FT_AT2"
?
cSearch := 't'
cSearch := "t"
? "Find occurrences of 't' in: "
cTarget := "This is the day that the Lord has made."
?? cTarget

34
harbour/contrib/hbnf/calendar.prg
View File

@@ -29,21 +29,21 @@ PROCEDURE Main()
LOCAL aRet[ 8 ], i
SetColor( 'w+/b' )
SetColor( "w+/b" )
cls
IF ft_numlock()
ft_numlock( .F. )
ENDIF
KEYBOARD Chr( 28 )
aRet := ft_calendar( 10, 40, 'w+/rb', .T. , .T. ) //display calendar, return all.
@ 1, 0 SAY 'Date :' + DToC( aRet[ 1 ] )
@ 2, 0 SAY 'Month Number:' + Str( aRet[ 2 ], 2, 0 )
@ 3, 0 SAY 'Day Number :' + Str( aRet[ 3 ], 2, 0 )
@ 4, 0 SAY 'Year Number :' + Str( aRet[ 4 ], 4, 0 )
@ 5, 0 SAY 'Month :' + aRet[ 5 ]
@ 6, 0 SAY 'Day :' + aRet[ 6 ]
@ 7, 0 SAY 'Julian Day :' + Str( aRet[ 7 ], 3, 0 )
@ 8, 0 SAY 'Current Time:' + aRet[ 8 ]
aRet := ft_calendar( 10, 40, "w+/rb", .T. , .T. ) //display calendar, return all.
@ 1, 0 SAY "Date :" + DToC( aRet[ 1 ] )
@ 2, 0 SAY "Month Number:" + Str( aRet[ 2 ], 2, 0 )
@ 3, 0 SAY "Day Number :" + Str( aRet[ 3 ], 2, 0 )
@ 4, 0 SAY "Year Number :" + Str( aRet[ 4 ], 4, 0 )
@ 5, 0 SAY "Month :" + aRet[ 5 ]
@ 6, 0 SAY "Day :" + aRet[ 6 ]
@ 7, 0 SAY "Julian Day :" + Str( aRet[ 7 ], 3, 0 )
@ 8, 0 SAY "Current Time:" + aRet[ 8 ]
RETURN
@@ -59,7 +59,7 @@ FUNCTION FT_CALENDAR( nRow, nCol, cColor, lShadow, lShowHelp )
nRow := iif( nRow != NIL, nRow, 1 ) //check display row
nCol := iif( nCol != NIL, nCol, 63 ) //check display col
cColor := iif( cColor != NIL, cColor, 'W+/G' ) //check display color
cColor := iif( cColor != NIL, cColor, "W+/G" ) //check display color
lShadow := iif( lShadow == NIL , .F. , lShadow ) //check shadow switch
lShowHelp := iif( lShowHelp == NIL , .F. , lShowHelp )//check help switch
@@ -113,7 +113,7 @@ FUNCTION FT_CALENDAR( nRow, nCol, cColor, lShadow, lShowHelp )
IF lShowHelp .AND. ! lHelpIsDisplayed
lHelpIsDisplayed := .T.
cSaveHelp := SaveScreen ( nHelpRow - 1, 1, nHelpRow + 7, 80 )
FT_XBOX( 'L', , , cColor, cColor, nHelpRow, 1, ;
FT_XBOX( "L", , , cColor, cColor, nHelpRow, 1, ;
"Home, Up_Arrow or PgUp keys page by day, month or year to a past date.", ;
"End, Dn_Arrow or PgDn keys page by day, month or year to a future date.", ;
"Left_Arrow or Right_Arrow keys page by week to a past or future date.", ;
@@ -131,15 +131,15 @@ FUNCTION FT_CALENDAR( nRow, nCol, cColor, lShadow, lShowHelp )
aRetVal[ 6 ] := CDOW( Date() + nJump )
aRetVal[ 7 ] := JDOY( aRetVal[ 4 ], aRetVal[ 2 ], aRetVal[ 3 ] )
@ nRow, nCol SAY SubStr( aRetval[ 6 ], 1, 3 ) + ' ' + ;
Str( aRetVal[ 3 ], 2, 0 ) + ' ' + ;
SubStr( aRetVal[ 5 ], 1, 3 ) + ' ' + ;
@ nRow, nCol SAY SubStr( aRetval[ 6 ], 1, 3 ) + " " + ;
Str( aRetVal[ 3 ], 2, 0 ) + " " + ;
SubStr( aRetVal[ 5 ], 1, 3 ) + " " + ;
Str( aRetVal[ 4 ], 4, 0 )
@ nRow + 1, nCol SAY Str( aRetVal[ 7 ], 3, 0 )
nKey := 0
DO WHILE nKey == 0
@ nRow + 1, nCol + 3 SAY ' ' + Time()
@ nRow + 1, nCol + 3 SAY " " + Time()
nKey := Inkey( 1 )
ENDDO
aRetVal[ 8 ] := Time()
@@ -156,7 +156,7 @@ FUNCTION FT_CALENDAR( nRow, nCol, cColor, lShadow, lShowHelp )
STATIC FUNCTION JDOY( nYear, nMonth, nDay )
LOCAL cString := '000031059090120151181212243273304334'
LOCAL cString := "000031059090120151181212243273304334"
RETURN VALS( cString, ( nMonth - 1 ) * 3 + 1, 3 ) + nDay + ;
iif( nYear % 4 == 0 .AND. nMonth > 2, 1, 0 )

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

@@ -54,7 +54,6 @@
//------------------------------------------------
// Pre-processor stuff
#include "box.ch"
#include "common.ch"
#include "setcurs.ch"
#include "inkey.ch"
@@ -65,10 +64,11 @@
#define C_CHAR 4
#translate Single( <t>, <l>, <b>, <r> ) =>;
@ < t > , < l > , < b > , < r > BOX B_SINGLE
@ < t > , < l > , < b > , < r > BOX hb_UTF8ToStr( "┌─┐│┘─└│" )
#translate Double( <t>, <l>, <b>, <r> ) =>;
@ < t > , < l > , < b > , < r > BOX B_DOUBLE
@ < t > , < l > , < b > , < r > BOX hb_UTF8ToStr( "╔═╗║╝═╚║" )
#translate ClearS( <t>, <l>, <b>, <r> ) =>;
@ < t > , < l > CLEAR TO < b > , < r >

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

@@ -59,8 +59,8 @@ FUNCTION ft_d2e( nDec, nPrecision )
IF Round( Abs( nDec ), nPrecision ) >= 10
nDec /= 10
nExp++
ENDIF // another kludge FOR stuff LIKE '999999999'
ENDIF // another kludge FOR stuff LIKE "999999999"
sScn := LTrim( Str( nDec, nPrecision + 3, nPrecision ) )
RETURN sScn + 'E' + AllTrim( Str( nExp, 5, 0 ) )
RETURN sScn + "E" + AllTrim( Str( nExp, 5, 0 ) )

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

@@ -79,13 +79,13 @@ FUNCTION DEMO()
LOCAL nNum, dDate, aTestData := {}, aTemp, cFY_Start, nDOW_Start
// SET DATE ANSI // User's normal date format
aTemp := FT_DATECNFG() // Get/Set cFY_Start & nDOW_Start.
// aTemp := FT_DATECNFG("1980.01.03", 1) // Date string in user's format.
cFY_Start := aTemp[ 1 ] // See FT_DATECNFG() in ft_date0.prg
nDOW_Start := ATEMP[ 2 ] // FOR PARAMETERS.
// SET DATE ANSI // User's normal date format
aTemp := FT_DATECNFG() // Get/Set cFY_Start & nDOW_Start.
// aTemp := FT_DATECNFG( "1980.01.03", 1 ) // Date string in user's format.
cFY_Start := aTemp[ 1 ] // See FT_DATECNFG() in ft_date0.prg
nDOW_Start := ATEMP[ 2 ] // FOR PARAMETERS.
dDate := Date()
// dDate := SToD( "19880229" ) // Test date, in user's normal date format
// dDate := SToD( "19880229" ) // Test date, in user's normal date format
CLS
? "Given Date: "
@@ -180,7 +180,7 @@ FUNCTION FT_CAL( dGivenDate, nType )
aTemp := FT_DATECNFG()
cFY_Start := aTemp[ 1 ]
IF dGivenDate == NIL .OR. !( ValType( dGivenDate ) $ 'ND' )
IF dGivenDate == NIL .OR. !( ValType( dGivenDate ) $ "ND" )
dGivenDate := Date()
ELSEIF HB_ISNUMERIC( dGivenDate )
nType := dGivenDate

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

@@ -31,7 +31,7 @@ FUNCTION FT_DAYOFYR( dGivenDate, nDayNum, lIsAcct )
LOCAL lIsDay, nTemp, aRetVal
IF !( ValType( dGivenDate ) $ 'NDL' )
IF !( ValType( dGivenDate ) $ "NDL" )
dGivenDate := Date()
ELSEIF HB_ISNUMERIC( dGivenDate )
nDayNum := dGivenDate
@@ -57,7 +57,7 @@ FUNCTION FT_DAYOFYR( dGivenDate, nDayNum, lIsAcct )
ENDIF
aRetVal[ 1 ] := aRetVal[ 2 ] + nDayNum - 1
ELSE
aRetVal[ 1 ] += PadL( LTrim( Str( dGivenDate - aRetVal[ 2 ] + 1, 3 ) ), 3, '0' )
aRetVal[ 1 ] += PadL( LTrim( Str( dGivenDate - aRetVal[ 2 ] + 1, 3 ) ), 3, "0" )
ENDIF
RETURN aRetVal

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

@@ -75,7 +75,7 @@ PROCEDURE Main()
FT_DFCLOSE()
@ 20, 0 SAY "Key pressed was: " + '[' + cKey + ']'
@ 20, 0 SAY "Key pressed was: " + "[" + cKey + "]"
RETURN

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

@@ -33,11 +33,6 @@
// beginning of demo program
#ifdef FT_TEST
// color variables
STATIC cNormH, cNormN, cNormE
STATIC cWindH, cWindN, cWindE
STATIC cErrH, cErrN, cErrE
PROCEDURE Main( cCmdLine )
LOCAL cDosScrn
@@ -47,7 +42,12 @@ PROCEDURE Main( cCmdLine )
LOCAL nMaxRow
LOCAL nType
// main routine starts here
// color variables
LOCAL cNormH, cNormN, cNormE
LOCAL cWindH, cWindN, cWindE
LOCAL cErrH, cErrN, cErrE
// main routine starts here
SET SCOREBOARD OFF
lColor := .T.

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

@@ -38,10 +38,10 @@ FUNCTION ft_e2d( sNumE )
LOCAL nMant, nExp
nMant := Val( Left( sNumE, At( 'E', sNumE ) - 1 ) )
nMant := Val( Left( sNumE, At( "E", sNumE ) - 1 ) )
nExp := Val( SubStr( sNumE, ;
At( 'E', sNumE ) + 1, ;
Len( sNumE ) - At( 'E', sNumE ) ;
At( "E", sNumE ) + 1, ;
Len( sNumE ) - At( "E", sNumE ) ;
) ;
)

32
harbour/contrib/hbnf/elapsed.prg
View File

@@ -33,8 +33,8 @@ FUNCTION DEMO()
LOCAL dStart, dEnd, cTimeStart, cTimeEnd, n, aDataTest := {}
dStart := SToD( '19901128' )
dEnd := SToD( '19901130' )
dStart := SToD( "19901128" )
dEnd := SToD( "19901130" )
cTimeStart := "08:00:00"
cTimeEnd := "12:10:30"
@@ -42,7 +42,7 @@ FUNCTION DEMO()
FOR n := 1 TO 4
? aDataTest[n,1], Str( aDataTest[n,2], 12, 4 )
?? " "
?? iif( n == 1, 'Days', iif( n == 2, 'Hours', iif( n == 3, 'Mins.', 'Secs.' ) ) )
?? iif( n == 1, "Days", iif( n == 2, "Hours", iif( n == 3, "Mins.", "Secs." ) ) )
NEXT
RETURN NIL
@@ -53,32 +53,32 @@ FUNCTION FT_ELAPSED( dStart, dEnd, cTimeStart, cTimeEnd )
LOCAL nTotalSec, nCtr, nConstant, nTemp, aRetVal[4,2]
IF ! ( ValType( dStart ) $ 'DC' )
IF ! ( ValType( dStart ) $ "DC" )
dStart := Date()
ELSEIF HB_ISSTRING( dStart )
cTimeStart := dStart
dStart := Date()
ENDIF
IF ! ( ValType( dEnd ) $ 'DC' )
IF ! ( ValType( dEnd ) $ "DC" )
dEnd := Date()
ELSEIF HB_ISSTRING( dEnd )
cTimeEnd := dEnd
dEnd := Date()
ENDIF
IF ! HB_ISSTRING( cTimeStart ); cTimeStart := '00:00:00' ; ENDIF
IF ! HB_ISSTRING( cTimeEnd ) ; cTimeEnd := '00:00:00' ; ENDIF
IF ! HB_ISSTRING( cTimeStart ); cTimeStart := "00:00:00" ; ENDIF
IF ! HB_ISSTRING( cTimeEnd ) ; cTimeEnd := "00:00:00" ; ENDIF
nTotalSec := ( dEnd - dStart ) * 86400 + ;
Val( cTimeEnd ) * 3600 + ;
Val( SubStr( cTimeEnd,At(':', cTimeEnd ) + 1,2 ) ) * 60 + ;
iif( RAt( ':', cTimeEnd ) == At( ':', cTimeEnd ), 0, ;
Val( SubStr( cTimeEnd,RAt(':', cTimeEnd ) + 1 ) ) ) - ;
Val( cTimeStart ) * 3600 - ;
Val( SubStr( cTimeStart,At(':', cTimeStart ) + 1,2 ) ) * 60 - ;
iif( RAt( ':', cTimeStart ) == At( ':', cTimeStart ), 0, ;
Val( SubStr( cTimeStart,RAt(':', cTimeStart ) + 1 ) ) )
nTotalSec := ( dEnd - dStart ) * 86400 + ;
Val( cTimeEnd ) * 3600 + ;
Val( SubStr( cTimeEnd, At( ":", cTimeEnd ) + 1,2 ) ) * 60 + ;
iif( RAt( ":", cTimeEnd ) == At( ":", cTimeEnd ), 0, ;
Val( SubStr( cTimeEnd, RAt( ":", cTimeEnd ) + 1 ) ) ) - ;
Val( cTimeStart ) * 3600 - ;
Val( SubStr( cTimeStart, At( ":", cTimeStart ) + 1, 2 ) ) * 60 - ;
iif( RAt( ":", cTimeStart ) == At( ":", cTimeStart ), 0, ;
Val( SubStr( cTimeStart, RAt( ":", cTimeStart ) + 1 ) ) )
nTemp := nTotalSec

5
harbour/contrib/hbnf/floptst.prg
View File

@@ -48,7 +48,6 @@
#define ERR_UNKNOWN 4
#ifdef FT_TEST
#define CR_LF hb_eol()
PROCEDURE Main( cArg1 )
@@ -56,9 +55,9 @@ PROCEDURE Main( cArg1 )
IF HB_ISSTRING( cArg1 )
nErrCode := FT_FLOPTST( Asc( Upper( cArg1 ) ) - Asc( "A" ) )
OutStd( "Return Code is " + LTrim( Str( nErrCode ) ) + CR_LF )
OutStd( "Return Code is " + LTrim( Str( nErrCode ) ) + hb_eol() )
ELSE
OutStd( "Usage: floptst cDrive" + CR_LF + " where cDrive is 'A' or 'B' etc..." + CR_LF )
OutStd( "Usage: floptst cDrive" + hb_eol() + " where cDrive is 'A' or 'B' etc..." + hb_eol() )
ENDIF
RETURN

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

@@ -29,7 +29,8 @@
PROCEDURE Main()
LOCAL cString
LOCAL aString := { "TRIM('abc ')", ;
LOCAL aString := { ;
"TRIM('abc ')", ;
"NotARealFunc()", ;
"FT_DispMsg()", ;
'TRIM(cVar+"abc"+LEFT(cString)), FOUND()', ;

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

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

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

@@ -31,7 +31,7 @@ FUNCTION FT_MONTH( dGivenDate, nMonthNum )
LOCAL lIsMonth, nTemp, aRetVal
IF !( ValType( dGivenDate ) $ 'ND' )
IF !( ValType( dGivenDate ) $ "ND" )
dGivenDate := Date()
ELSEIF HB_ISNUMERIC( dGivenDate )
nMonthNum := dGivenDate
@@ -51,7 +51,7 @@ FUNCTION FT_MONTH( dGivenDate, nMonthNum )
nTemp := Month( dGivenDate ) - Month( aRetVal[ 2 ] )
nTemp += iif( nTemp >= 0, 1, 13 )
aRetVal[ 1 ] += PadL( LTrim( Str( nTemp, 2 ) ), 2, '0' )
aRetVal[ 1 ] += PadL( LTrim( Str( nTemp, 2 ) ), 2, "0" )
aRetVal[ 2 ] := FT_MADD( aRetVal[ 2 ], nTemp - 1 )
aRetVal[ 3 ] := FT_MADD( aRetVal[ 2 ], 1 ) - 1

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

@@ -31,10 +31,10 @@
FUNCTION FT_PCHR( c_nums )
LOCAL c_ret := '', c_st := 0, c_part, c_st2, c_hex := "0123456789ABCDEF"
LOCAL c_ret := "", c_st := 0, c_part, c_st2, c_hex := "0123456789ABCDEF"
LOCAL c_upper, c_t1, c_t2
IF SubStr( c_nums, 1, 1 ) == ',' .OR. Trim( c_nums ) == ''
IF SubStr( c_nums, 1, 1 ) == "," .OR. Trim( c_nums ) == ""
RETURN ""
ENDIF
@@ -73,63 +73,63 @@ FUNCTION FT_PCHR( c_nums )
#define LEFTEQUAL( l, r ) ( Left( l, Len( r ) ) == r )
DO CASE
CASE LEFTEQUAL( c_upper, '/GRAPHIC' )
CASE LEFTEQUAL( c_upper, "/GRAPHIC" )
c_ret += Chr( 27 ) + Chr( 116 ) + Chr( 1 )
CASE LEFTEQUAL( c_upper, '/ITALIC' )
CASE LEFTEQUAL( c_upper, "/ITALIC" )
c_ret += Chr( 27 ) + Chr( 116 ) + Chr( 0 )
CASE LEFTEQUAL( c_upper, '/PICTURE' )
CASE LEFTEQUAL( c_upper, "/PICTURE" )
c_ret += Chr( 27 ) + Chr( 116 ) + Chr( 1 ) + ;
Chr( 27 ) + Chr( 120 ) + Chr( 1 ) + Chr( 27 ) + Chr( 107 ) + Chr( 1 ) + ;
Chr( 27 ) + Chr( 77 ) + Chr( 27 ) + 'U'
CASE LEFTEQUAL( c_upper, '/COND' ) .OR. LEFTEQUAL( c_upper, '/SI' )
Chr( 27 ) + Chr( 77 ) + Chr( 27 ) + "U"
CASE LEFTEQUAL( c_upper, "/COND" ) .OR. LEFTEQUAL( c_upper, "/SI" )
c_ret += Chr( 15 )
CASE LEFTEQUAL( c_upper, '/ROMAN' )
CASE LEFTEQUAL( c_upper, "/ROMAN" )
c_ret += Chr( 27 ) + Chr( 107 ) + Chr( 0 )
CASE LEFTEQUAL( c_upper, '/SANS' )
CASE LEFTEQUAL( c_upper, "/SANS" )
c_ret += Chr( 27 ) + Chr( 107 ) + Chr( 1 )
CASE LEFTEQUAL( c_upper, '/NLQ' )
CASE LEFTEQUAL( c_upper, "/NLQ" )
c_ret += Chr( 27 ) + Chr( 120 ) + Chr( 1 )
CASE LEFTEQUAL( c_upper, '/DRAFT' )
CASE LEFTEQUAL( c_upper, "/DRAFT" )
c_ret += Chr( 27 ) + Chr( 120 ) + Chr( 0 )
CASE LEFTEQUAL( c_upper, '/ELITE' )
CASE LEFTEQUAL( c_upper, "/ELITE" )
c_ret += Chr( 27 ) + Chr( 77 )
CASE LEFTEQUAL( c_upper, '/PICA' )
CASE LEFTEQUAL( c_upper, "/PICA" )
c_ret += Chr( 27 ) + Chr( 80 )
CASE LEFTEQUAL( c_upper, '/EMPHOFF' )
CASE LEFTEQUAL( c_upper, "/EMPHOFF" )
c_ret += Chr( 27 ) + Chr( 70 )
CASE LEFTEQUAL( c_upper, '/EMPH' )
CASE LEFTEQUAL( c_upper, "/EMPH" )
c_ret += Chr( 27 ) + Chr( 69 )
CASE LEFTEQUAL( c_upper, '/1/6' )
CASE LEFTEQUAL( c_upper, "/1/6" )
c_ret += Chr( 27 ) + Chr( 50 )
CASE LEFTEQUAL( c_upper, '/1/8' )
CASE LEFTEQUAL( c_upper, "/1/8" )
c_ret += Chr( 27 ) + Chr( 48 )
CASE LEFTEQUAL( c_upper, '/SKIPOFF' )
CASE LEFTEQUAL( c_upper, "/SKIPOFF" )
c_ret += Chr( 27 ) + Chr( 79 )
CASE LEFTEQUAL( c_upper, '/SKIP' )
CASE LEFTEQUAL( c_upper, "/SKIP" )
c_ret += Chr( 27 ) + Chr( 78 )
CASE LEFTEQUAL( c_upper, '/FF' ) .OR. LEFTEQUAL( c_upper, '/EJECT' )
CASE LEFTEQUAL( c_upper, "/FF" ) .OR. LEFTEQUAL( c_upper, "/EJECT" )
c_ret += Chr( 12 )
CASE LEFTEQUAL( c_upper, '/INIT' ) .OR. LEFTEQUAL( c_upper, '/RESET' )
CASE LEFTEQUAL( c_upper, "/INIT" ) .OR. LEFTEQUAL( c_upper, "/RESET" )
c_ret += Chr( 27 ) + Chr( 64 )
CASE LEFTEQUAL( c_upper, '/SPANISH' )
CASE LEFTEQUAL( c_upper, "/SPANISH" )
c_ret += Chr( 27 ) + Chr( 82 ) + Chr( 12 )
CASE LEFTEQUAL( c_upper, '/USA' )
CASE LEFTEQUAL( c_upper, "/USA" )
c_ret += Chr( 27 ) + Chr( 82 ) + Chr( 0 )
CASE LEFTEQUAL( c_upper, '/ONE' )
c_ret += Chr( 27 ) + 'U' + Chr( 1 )
CASE LEFTEQUAL( c_upper, '/TWO' )
c_ret += Chr( 27 ) + 'U' + Chr( 0 )
CASE LEFTEQUAL( c_upper, '/FAST' )
c_ret += Chr( 27 ) + 's' + Chr( 0 )
CASE LEFTEQUAL( c_upper, '/SLOW' )
c_ret += Chr( 27 ) + 's' + Chr( 1 )
CASE LEFTEQUAL( c_upper, '/OFF' )
CASE LEFTEQUAL( c_upper, "/ONE" )
c_ret += Chr( 27 ) + "U" + Chr( 1 )
CASE LEFTEQUAL( c_upper, "/TWO" )
c_ret += Chr( 27 ) + "U" + Chr( 0 )
CASE LEFTEQUAL( c_upper, "/FAST" )
c_ret += Chr( 27 ) + "s" + Chr( 0 )
CASE LEFTEQUAL( c_upper, "/SLOW" )
c_ret += Chr( 27 ) + "s" + Chr( 1 )
CASE LEFTEQUAL( c_upper, "/OFF" )
c_ret += Chr( 19 )
CASE LEFTEQUAL( c_upper, '/ON' )
CASE LEFTEQUAL( c_upper, "/ON" )
c_ret += Chr( 17 )
CASE LEFTEQUAL( c_upper, '/BEEP' ) .OR. LEFTEQUAL( c_upper, '/BELL' )
CASE LEFTEQUAL( c_upper, "/BEEP" ) .OR. LEFTEQUAL( c_upper, "/BELL" )
c_ret += Chr( 7 )
CASE LEFTEQUAL( c_upper, '/CAN' )
CASE LEFTEQUAL( c_upper, "/CAN" )
c_ret += Chr( 24 )
ENDCASE

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

@@ -35,7 +35,7 @@
#translate SINGLEBOX(<top>, <left>, <bottom>, <right>) => ;
@ < top > , < left > , < bottom > , < right > BOX hb_UTF8ToStr( "┌─┐│┘─└│ " )
#translate DOUBLEBOX(<top>, <left>, <bottom>, <right>) => ;
@ < top > , < left > , < bottom > , < right > BOX hb_UTF8ToStr( '╔═╗║╝═╚║ ' )
@ < top > , < left > , < bottom > , < right > BOX hb_UTF8ToStr( "╔═╗║╝═╚║ " )
MEMVAR getlist
/*
@@ -83,7 +83,7 @@ THREAD STATIC board_ := { { { 0, 29, 2, 34 }, { 2, 4 }, { 3, 9 }, .T. } , ;
FUNCTION FT_PEGS()
LOCAL XX, MOVE, MPOS, POSSIBLE_, BUFFER, TOPROW, OLDSCORE, MOVE2
LOCAL SCANBLOCK, OLDCOLOR := SetColor( 'w/n' )
LOCAL SCANBLOCK, OLDCOLOR := SetColor( "w/n" )
LOCAL oldscrn := SaveScreen( 0, 0, MaxRow(), MaxCol() )
/*
the following code block is used in conjunction with ASCAN()
@@ -92,14 +92,14 @@ FUNCTION FT_PEGS()
scanblock := {| a | a[ 2 ] == move2 }
cls
SetColor( 'w/r' )
SetColor( "w/r" )
SINGLEBOX( 22, 31, 24, 48 )
@ 23, 33 SAY "Your move:"
AEval( board_, {| a, x | HB_SYMBOL_UNUSED( a ), drawbox( x ) } )
DO WHILE LastKey() != K_ESC .AND. moremoves()
move := 1
SetColor( 'w/n' )
@ 23, 44 GET move PICTURE '##' RANGE 1, 33
SetColor( "w/n" )
@ 23, 44 GET move PICTURE "##" RANGE 1, 33
READ
IF move > 0
DO CASE
@@ -123,19 +123,19 @@ FUNCTION FT_PEGS()
drawbox( possible_[ 1, 1 ] )
drawbox( possible_[ 1, 2 ] )
CASE Len( possible_ ) == 0
err_msg( 'Illegal move!' )
err_msg( "Illegal move!" )
OTHERWISE
move2 := possible_[ 1, 2 ]
toprow := 21 - Len( possible_ )
SetColor( '+w/b' )
SetColor( "+w/b" )
buffer := SaveScreen( toprow, 55, 22, 74 )
DOUBLEBOX( toprow, 55, 22, 74 )
@ toprow, 58 SAY 'Possible Moves'
@ toprow, 58 SAY "Possible Moves"
DevPos( toprow, 65 )
AEval( possible_, {| a | DevPos( Row() + 1, 65 ), ;
DevOutPict( a[ 2 ], '##' ) } )
DevOutPict( a[ 2 ], "##" ) } )
oldscore := Set( _SET_SCOREBOARD, .F. )
@23, 44 GET move2 PICTURE '##' ;
@23, 44 GET move2 PICTURE "##" ;
VALID AScan( possible_, scanblock ) > 0
READ
RestScreen( toprow, 55, 22, 74, buffer )
@@ -162,7 +162,7 @@ FUNCTION FT_PEGS()
STATIC FUNCTION DrawBox( nelement )
SetColor( iif( board_[ nelement ][ 4 ], '+w/rb', 'w/n' ) )
SetColor( iif( board_[ nelement ][ 4 ], "+w/rb", "w/n" ) )
@ board_[ nelement ][ 1, 1 ], board_[ nelement ][1,2], board_[ nelement ][ 1, 3 ], ;
board_[ nelement ][ 1, 4 ] BOX hb_UTF8ToStr( "┌─┐│┘─└│ " )
DevPos( board_[ nelement ][ 1, 1 ] + 1, board_[ nelement ][ 1, 2 ] + 2 )
@@ -177,7 +177,7 @@ STATIC FUNCTION err_msg( msg )
LOCAL buffer := SaveScreen( 23, 33, 23, 47 )
SetCursor( SC_NONE )
SetColor( '+w/r' )
SetColor( "+w/r" )
@ 23, 33 SAY msg
Inkey( 2 )
SetCursor( SC_NORMAL )
@@ -206,7 +206,7 @@ STATIC FUNCTION moremoves()
ENDIF
NEXT
IF ! canmove
SetColor( '+w/b' )
SetColor( "+w/b" )
buffer := SaveScreen( 18, 55, 21, 74 )
DOUBLEBOX( 18, 55, 21, 74 )
@ 19, 58 SAY "No more moves!"

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

@@ -40,7 +40,7 @@ PROCEDURE Main()
FUNCTION FT_PENDING( cMsg, nRow, nCol, nWait, cColor )
THREAD STATIC nLast_Time := 0, nRow1 := 24, nCol1 := 0
THREAD STATIC nWait1 := 5, cColor1 := 'W+/R,X'
THREAD STATIC nWait1 := 5, cColor1 := "W+/R,X"
LOCAL nThis_Time, nTiny := 0.1, cSavColor
//

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

@@ -24,8 +24,6 @@
*
*/
#include "box.ch"
// test code
#ifdef FT_TEST
@@ -40,10 +38,11 @@ PROCEDURE Main()
FUNCTION FT_PICKDAY()
LOCAL DAYS := { "SUNDAY", "MONDAY", "TUESDAY", "WEDNESDAY", "THURSDAY", ;
"FRIDAY", "SATURDAY" }, SEL := 0
LOCAL OLDSCRN := SaveScreen( 8, 35, 16, 45 ), oldcolor := SetColor( '+w/r' )
"FRIDAY", "SATURDAY" }
LOCAL SEL := 0
LOCAL OLDSCRN := SaveScreen( 8, 35, 16, 45 ), oldcolor := SetColor( "+w/r" )
@ 8, 35, 16, 45 BOX B_SINGLE + " "
@ 8, 35, 16, 45 BOX hb_UTF8ToStr( "┌─┐│┘─└│ " )
/* do not allow user to Esc out, which would cause array access error */
DO WHILE sel == 0
sel := AChoice( 9, 36, 15, 44, days )
@@ -52,4 +51,4 @@ FUNCTION FT_PICKDAY()
RestScreen( 8, 35, 16, 45, oldscrn )
SetColor( oldcolor )
RETURN days[sel]
RETURN days[ sel ]

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

@@ -46,7 +46,7 @@
#define W_CURR NIL
// Set up manifest constants to access the Standard screen colors in the array
// aStdColor
// aStdColor
#define STD_ACCENT 1
#define STD_ERROR 2
#define STD_PROMPT 3
@@ -65,15 +65,14 @@
#define B_DOUBLE hb_UTF8ToStr( "╔═╗║╝═╚║ " )
#define B_SINGLE "+-+|+-+| "
#define CRLF Chr( 13 ) + Chr( 10 )
#define nTotTran LEN( aTrans )
#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> */
#command FT_INKEY [ <secs> ] TO <var> ;
@@ -369,21 +368,21 @@ STATIC FUNCTION _ftAddScreen( aAdder )
_ftPushWin( 2 + nTopOS, 2 + nAddSpace, 22 + nTopOS, 30 + nAddSpace, " Adder ", ;
"<F-1> for Help", , B_DOUBLE )
nCol := 5 + nAddSpace
@ 7 + nTopOS, nCol SAY hb_UTF8ToStr( ' ┌───┐ ┌───┐ ┌───┐' )
@ 8 + nTopOS, nCol SAY hb_UTF8ToStr( ' │ │ │ │ │ │' )
@ 9 + nTopOS, nCol SAY hb_UTF8ToStr( ' └───┘ └───┘ └───┘' )
@ 10 + nTopOS, nCol SAY hb_UTF8ToStr( '┌───┐ ┌───┐ ┌───┐ ┌───┐' )
@ 11 + nTopOS, nCol SAY hb_UTF8ToStr( '│ │ │ │ │ │ │ │' )
@ 12 + nTopOS, nCol SAY hb_UTF8ToStr( '└───┘ └───┘ └───┘ │ │' )
@ 13 + nTopOS, nCol SAY hb_UTF8ToStr( '┌───┐ ┌───┐ ┌───┐ │ │' )
@ 14 + nTopOS, nCol SAY hb_UTF8ToStr( '│ │ │ │ │ │ │ │' )
@ 15 + nTopOS, nCol SAY hb_UTF8ToStr( '└───┘ └───┘ └───┘ └───┘' )
@ 16 + nTopOS, nCol SAY hb_UTF8ToStr( '┌───┐ ┌───┐ ┌───┐ ┌───┐' )
@ 17 + nTopOS, nCol SAY hb_UTF8ToStr( '│ │ │ │ │ │ │ │' )
@ 18 + nTopOS, nCol SAY hb_UTF8ToStr( '└───┘ └───┘ └───┘ │ │' )
@ 19 + nTopOS, nCol SAY hb_UTF8ToStr( '┌─────────┐ ┌───┐ │ │' )
@ 20 + nTopOS, nCol SAY hb_UTF8ToStr( '│ │ │ │ │ │' )
@ 21 + nTopOS, nCol SAY hb_UTF8ToStr( '└─────────┘ └───┘ └───┘' )
@ 7 + nTopOS, nCol SAY hb_UTF8ToStr( " ┌───┐ ┌───┐ ┌───┐" )
@ 8 + nTopOS, nCol SAY hb_UTF8ToStr( " │ │ │ │ │ │" )
@ 9 + nTopOS, nCol SAY hb_UTF8ToStr( " └───┘ └───┘ └───┘" )
@ 10 + nTopOS, nCol SAY hb_UTF8ToStr( "┌───┐ ┌───┐ ┌───┐ ┌───┐" )
@ 11 + nTopOS, nCol SAY hb_UTF8ToStr( "│ │ │ │ │ │ │ │" )
@ 12 + nTopOS, nCol SAY hb_UTF8ToStr( "└───┘ └───┘ └───┘ │ │" )
@ 13 + nTopOS, nCol SAY hb_UTF8ToStr( "┌───┐ ┌───┐ ┌───┐ │ │" )
@ 14 + nTopOS, nCol SAY hb_UTF8ToStr( "│ │ │ │ │ │ │ │" )
@ 15 + nTopOS, nCol SAY hb_UTF8ToStr( "└───┘ └───┘ └───┘ └───┘" )
@ 16 + nTopOS, nCol SAY hb_UTF8ToStr( "┌───┐ ┌───┐ ┌───┐ ┌───┐" )
@ 17 + nTopOS, nCol SAY hb_UTF8ToStr( "│ │ │ │ │ │ │ │" )
@ 18 + nTopOS, nCol SAY hb_UTF8ToStr( "└───┘ └───┘ └───┘ │ │" )
@ 19 + nTopOS, nCol SAY hb_UTF8ToStr( "┌─────────┐ ┌───┐ │ │" )
@ 20 + nTopOS, nCol SAY hb_UTF8ToStr( "│ │ │ │ │ │" )
@ 21 + nTopOS, nCol SAY hb_UTF8ToStr( "└─────────┘ └───┘ └───┘" )
_ftSetWinColor( W_CURR, W_TITLE )
nCol := 7 + nAddSpace
@ 11 + nTopOS, nCol SAY "7"
@@ -780,21 +779,21 @@ STATIC FUNCTION _ftMultDiv( aAdder, nKey )
STATIC FUNCTION _ftAddHelp
LOCAL cMess := "This Adder works like a desk top calculator. You may add," + ;
" subtract, multiply, or divide. " + CRLF + CRLF + ;
" subtract, multiply, or divide. " + hb_eol() + hb_eol() + ;
"When adding or subtracting, the first entry is entered " + ;
"into the accumulator and each sucessive entry is " + ;
"subtotaled. When you press <ENTER> the SubTotal is also " + ;
"shown on the tape. The second time you press <ENTER> the " + ;
"adder is Totaled. When multiplying or dividing the " + ;
"<ENTER> is a Total the first time pressed." + CRLF + CRLF + ;
"Hot Keys:" + CRLF + ;
" <D>ecimals - change # of decimals" + CRLF + ;
" <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 + ;
" +-- 2nd Clear ADDER" + CRLF + ;
" <ESC> - Quit" + CRLF + ;
"<ENTER> is a Total the first time pressed." + hb_eol() + hb_eol() + ;
"Hot Keys:" + hb_eol() + ;
" <D>ecimals - change # of decimals" + hb_eol() + ;
" <M>ove - the Adder from right to left" + hb_eol() + ;
" <T>ape - turn Tape Display On or Off" + hb_eol() + ;
" <S>croll - the tape display" + hb_eol() + hb_eol() + ;
" <DEL> ---+-- 1st Clear entry" + hb_eol() + ;
" +-- 2nd Clear ADDER" + hb_eol() + ;
" <ESC> - Quit" + hb_eol() + ;
" <F10> - return a <TOTAL> to the active get"
_ftPushMessage( cMess, .T. , "ADDER HELP", "press any key to continue...", ;

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

@@ -31,7 +31,7 @@ FUNCTION FT_QTR( dGivenDate, nQtrNum )
LOCAL lIsQtr, nTemp, aRetVal
IF !( ValType( dGivenDate ) $ 'ND' )
IF !( ValType( dGivenDate ) $ "ND" )
dGivenDate := Date()
ELSEIF HB_ISNUMERIC( dGivenDate )
nQtrNum := dGivenDate
@@ -52,7 +52,7 @@ FUNCTION FT_QTR( dGivenDate, nQtrNum )
nTemp += iif( nTemp >= 0, 1, 13 )
nTemp := Int( ( nTemp - 1 ) / 3 )
aRetVal[ 1 ] += PadL( LTrim( Str( nTemp + 1, 2 ) ), 2, '0' )
aRetVal[ 1 ] += PadL( LTrim( Str( nTemp + 1, 2 ) ), 2, "0" )
aRetVal[ 2 ] := FT_MADD( aRetVal[ 2 ], nTemp * 3 )
aRetVal[ 3 ] := FT_MADD( aRetVal[ 2 ], 3 ) - 1

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

@@ -36,23 +36,23 @@ MEMVAR lRet
#ifdef FT_TEST // test program to demonstrate functions
LOCAL aArray := {;
{ 'Invoice 1', SToD( "19910415" ), 1234.32, .T. }, ;
{ 'Invoice 2', Date(), 234.98, .F. }, ;
{ 'Invoice 3', Date() + 1, 0, .T. } }, aSave
{ "Invoice 1", SToD( "19910415" ), 1234.32, .T. }, ;
{ "Invoice 2", Date(), 234.98, .F. }, ;
{ "Invoice 3", Date() + 1, 0, .T. } }, aSave
LOCAL nErrorCode := 0
FT_SAVEARR( aArray, 'invoice.dat', @nErrorCode )
FT_SAVEARR( aArray, "invoice.dat", @nErrorCode )
IF nErrorCode == 0
CLS
DispArray( aArray )
aSave := FT_RESTARR( 'invoice.dat', @nErrorCode )
aSave := FT_RESTARR( "invoice.dat", @nErrorCode )
IF nErrorCode == 0
DispArray( aSave )
ELSE
? 'Error restoring array'
? "Error restoring array"
ENDIF
ELSE
? 'Error writing array'
? "Error writing array"
ENDIF
RETURN
@@ -63,12 +63,12 @@ FUNCTION DispArray( aTest )
FOR nk := 1 TO Len( aTest )
? aTest[ nk, 1 ]
?? ' '
?? " "
?? DToC( aTest[ nk, 2 ] )
?? ' '
?? " "
?? Str( aTest[ nk, 3 ] )
?? ' '
?? iif( aTest[ nk, 4 ], 'true', 'false' )
?? " "
?? iif( aTest[ nk, 4 ], "true", "false" )
NEXT
RETURN NIL
@@ -158,7 +158,7 @@ STATIC FUNCTION _ftrestsub( nHandle, nErrorCode )
LOCAL cValType, nLen, cLenStr, xMemVar, cMemVar, nk
cValType := ' '
cValType := " "
FRead( nHandle, @cValType, 1 )
cLenStr := Space( 4 )
FRead( nHandle, @cLenStr, 4 )
@@ -179,7 +179,7 @@ STATIC FUNCTION _ftrestsub( nHandle, nErrorCode )
FRead( nHandle, @cMemVar, 8 )
xMemVar := CToD( cMemVar )
CASE cValType == "L"
cMemVar := ' '
cMemVar := " "
FRead( nHandle, @cMemVar, 1 )
xMemVar := ( cMemVar == "T" )
CASE cValType == "N"

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

@@ -248,8 +248,8 @@ FUNCTION FT_BRWSWHL( aFields, bWhileCond, cKey, nFreeze, lSaveScrn, ;
cColorSave := SetColor()
/* Background Color Is Based On First Color In Passed cColorList */
cColorBack := iif( ',' $ cColorList, ;
SubStr( cColorList, 1, At( ',', cColorList ) - 1 ), cColorList )
cColorBack := iif( "," $ cColorList, ;
SubStr( cColorList, 1, At( ",", cColorList ) - 1 ), cColorList )
IF ! lKeepScrn
SetColor( cColorBack )

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

@@ -99,7 +99,7 @@ FUNCTION FT_TEMPFIL( cPath, lHide, nHandle )
LOCAL cFile
hb_default( @cPath, ".\" )
hb_default( @cPath, "." + hb_ps() )
hb_default( @lHide, .F. )
cPath := AllTrim( cPath )

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

@@ -21,8 +21,6 @@
*
*/
#include "box.ch"
// test code
#ifdef FT_TEST
@@ -112,7 +110,7 @@ FUNCTION ft_menu2( aMenuInfo, cColors )
cOldscreen := SaveScreen( nTop, nLeft - 1, nTop + nOptions + 1, nLeft + nMaxwidth )
@ nTop, nLeft - 1, nTop + nOptions + 1, nLeft + nMaxwidth BOX B_SINGLE + ' '
@ nTop, nLeft - 1, nTop + nOptions + 1, nLeft + nMaxwidth BOX hb_UTF8ToStr( "┌─┐│┘─└│ " )
DevPos( nTop, nLeft )
FOR x := 1 TO Len( aMenuInfo )
IF Len( aMenuInfo[ x ] ) > 1 .AND. aMenuInfo[ x, 2 ] != NIL

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

@@ -31,7 +31,7 @@ FUNCTION FT_WEEK( dGivenDate, nWeekNum )
LOCAL lIsWeek, nTemp, aRetVal, dTemp
IF ! ( ValType( dGivenDate ) $ 'ND' )
IF ! ( ValType( dGivenDate ) $ "ND" )
dGivenDate := Date()
ELSEIF HB_ISNUMERIC( dGivenDate )
nWeekNum := dGivenDate
@@ -54,7 +54,7 @@ FUNCTION FT_WEEK( dGivenDate, nWeekNum )
dGivenDate += ( 6 - FT_DAYTOBOW( dGivenDate ) ) // end of week
aRetVal[ 1 ] += PadL( LTrim( Str( Int( ( dGivenDate - ;
aRetVal[ 2 ] ) / 7 ) + 1, 2 ) ), 2, '0' )
aRetVal[ 2 ] ) / 7 ) + 1, 2 ) ), 2, "0" )
aRetVal[ 2 ] := Max( dGivenDate - 6, dTemp )
aRetVal[ 3 ] := Min( dGivenDate, aRetVal[ 3 ] )