diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 37993a3fb3..2f5d337ab3 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,121 @@ The license applies to all entries newer than 2009-04-28. */ +2012-09-29 19:44 UTC+0200 Viktor Szakats (harbour syenar.net) + + contrib/hbnf/tests/aading.prg + + contrib/hbnf/tests/aemaxlen.prg + + contrib/hbnf/tests/aeminlen.prg + + contrib/hbnf/tests/amedian.prg + + contrib/hbnf/tests/aredit.prg + + contrib/hbnf/tests/at2.prg + + contrib/hbnf/tests/blink.prg + + contrib/hbnf/tests/calendar.prg + + contrib/hbnf/tests/clrsel.prg + + contrib/hbnf/tests/d2e.prg + + contrib/hbnf/tests/datecnfg.prg + + contrib/hbnf/tests/dectobin.prg + + contrib/hbnf/tests/dfile.prg + + contrib/hbnf/tests/diskfunc.prg + + contrib/hbnf/tests/dispmsg.prg + + contrib/hbnf/tests/dosver.prg + + contrib/hbnf/tests/e2d.prg + + contrib/hbnf/tests/elapsed.prg + + contrib/hbnf/tests/findith.prg + + contrib/hbnf/tests/floptst.prg + + contrib/hbnf/tests/gcd.prg + + contrib/hbnf/tests/hex2dec.prg + + contrib/hbnf/tests/isshare.prg + + contrib/hbnf/tests/linked.prg + + contrib/hbnf/tests/menu1.prg + + contrib/hbnf/tests/metaph.prg + + contrib/hbnf/tests/miltime.prg + + contrib/hbnf/tests/mouse1.prg + + contrib/hbnf/tests/mouse2.prg + + contrib/hbnf/tests/netpv.prg + + contrib/hbnf/tests/ntow.prg + + contrib/hbnf/tests/nwlstat.prg + + contrib/hbnf/tests/nwsem.prg + + contrib/hbnf/tests/nwuid.prg + + contrib/hbnf/tests/pending.prg + + contrib/hbnf/tests/pickday.prg + + contrib/hbnf/tests/popadder.prg + + contrib/hbnf/tests/prtesc.prg + + contrib/hbnf/tests/rand1.prg + + contrib/hbnf/tests/savearr.prg + + contrib/hbnf/tests/savesets.prg + + contrib/hbnf/tests/scancode.prg + + contrib/hbnf/tests/setdate.prg + + contrib/hbnf/tests/settime.prg + + contrib/hbnf/tests/sleep.prg + + contrib/hbnf/tests/sysmem.prg + + contrib/hbnf/tests/tbwhile.prg + + contrib/hbnf/tests/tempfile.prg + + contrib/hbnf/tests/vertmenu.prg + + contrib/hbnf/tests/vidmode.prg + + contrib/hbnf/tests/wda.prg + + contrib/hbnf/tests/workdays.prg + + contrib/hbnf/tests/woy.prg + + contrib/hbnf/tests/xbox.prg + - contrib/hbnf/hbmk.hbm + - contrib/hbnf/tests/nftest.prg + * contrib/hbnf/aading.prg + * contrib/hbnf/aemaxlen.prg + * contrib/hbnf/aeminlen.prg + * contrib/hbnf/amedian.prg + * contrib/hbnf/aredit.prg + * contrib/hbnf/at2.prg + * contrib/hbnf/blink.prg + * contrib/hbnf/calendar.prg + * contrib/hbnf/clrsel.prg + * contrib/hbnf/d2e.prg + * contrib/hbnf/datecnfg.prg + * contrib/hbnf/dectobin.prg + * contrib/hbnf/dfile.prg + * contrib/hbnf/diskfunc.prg + * contrib/hbnf/dispmsg.prg + * contrib/hbnf/dosver.prg + * contrib/hbnf/e2d.prg + * contrib/hbnf/elapsed.prg + * contrib/hbnf/findith.prg + * contrib/hbnf/floptst.prg + * contrib/hbnf/gcd.prg + * contrib/hbnf/hex2dec.prg + * contrib/hbnf/isshare.prg + * contrib/hbnf/linked.prg + * contrib/hbnf/menu1.prg + * contrib/hbnf/metaph.prg + * contrib/hbnf/miltime.prg + * contrib/hbnf/mouse1.prg + * contrib/hbnf/mouse2.prg + * contrib/hbnf/netpv.prg + * contrib/hbnf/ntow.prg + * contrib/hbnf/nwlstat.prg + * contrib/hbnf/nwsem.prg + * contrib/hbnf/nwuid.prg + * contrib/hbnf/pending.prg + * contrib/hbnf/pickday.prg + * contrib/hbnf/popadder.prg + * contrib/hbnf/prtesc.prg + * contrib/hbnf/rand1.prg + * contrib/hbnf/savearr.prg + * contrib/hbnf/savesets.prg + * contrib/hbnf/scancode.prg + * contrib/hbnf/setdate.prg + * contrib/hbnf/settime.prg + * contrib/hbnf/sleep.prg + * contrib/hbnf/sysmem.prg + * contrib/hbnf/tbwhile.prg + * contrib/hbnf/tempfile.prg + * contrib/hbnf/vertmenu.prg + * contrib/hbnf/vidmode.prg + * contrib/hbnf/wda.prg + * contrib/hbnf/workdays.prg + * contrib/hbnf/woy.prg + * contrib/hbnf/xbox.prg + + extracted FT_TEST code into separate .prg files and + copied to /tests dir, replacing nftest.prg which was + a copy of the same code merged into one file. + 2012-09-29 18:34 UTC+0200 Viktor Szakats (harbour syenar.net) * contrib/hbnf/aavg.prg * contrib/hbnf/adessort.prg diff --git a/harbour/contrib/hbnf/aading.prg b/harbour/contrib/hbnf/aading.prg index 753cb8c9ad..8524c656c3 100644 --- a/harbour/contrib/hbnf/aading.prg +++ b/harbour/contrib/hbnf/aading.prg @@ -21,48 +21,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL aList1, aList2, var0, nstart, nstop, nelapsed, nCtr - - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AADDITION" - ? - aList1 := { "apple", "orange", "pear" } - aList2 := { "apple ", "banana", "PEAR" } - ? "aList1 : " - AEval( aList1, {| x | QQOut( x + "," ) } ) - ? - ? "aList2 : " - AEval( aList2, {| x | QQOut( x + "," ) } ) - ? - - nstart := Seconds() - FOR nCtr := 1 TO 100 - var0 := FT_AADDITION( aList1, aList2 ) - NEXT - nstop := Seconds() - nelapsed := nstop - nstart - ? "time for 100 merges:", nelapsed - - ? PadR( "FT_AADDITION( aList1, aList2 ) ->", 44 ) - AEval( var0, {| x | QQOut( x + "," ) } ) - ? - var0 := FT_AADDITION( aList1, aList2, , .F. ) - ? PadR( "FT_AADDITION( aList1, aList2, , .F. ) ->", 44 ) - AEval( var0, {| x | QQOut( x + "," ) } ) - ? - var0 := FT_AADDITION( aList1, aList2, .F. , .F. ) - ? PadR( "FT_AADDITION( aList1, aList2, .F., .F. ) ->", 44 ) - AEval( var0, {| x | QQOut( x + "," ) } ) - ? - - RETURN - -#endif - FUNCTION FT_AADDITION( aList1, aList2, lTrimmer, lCaseSens ) LOCAL nElement, nPos, bScanCode diff --git a/harbour/contrib/hbnf/aemaxlen.prg b/harbour/contrib/hbnf/aemaxlen.prg index edbc6bf3a7..b396409e4e 100644 --- a/harbour/contrib/hbnf/aemaxlen.prg +++ b/harbour/contrib/hbnf/aemaxlen.prg @@ -21,38 +21,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL var0, myarray1 := Directory() - - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AEMAXLEN" - ? - ? "myarray1 := DIRECTORY()" - ? - var0 := FT_AEMAXLEN( myarray1 ) - ? PadR( "FT_AEMAXLEN( myarray1 ) ->", 30 ) - ?? var0 - ? - var0 := FT_AEMAXLEN( myarray1, 2 ) - ? PadR( "FT_AEMAXLEN( myarray1, 2 ) ->", 30 ) - ?? var0 - ? - var0 := FT_AEMAXLEN( myarray1, 3 ) - ? PadR( "FT_AEMAXLEN( myarray1, 3 ) ->", 30 ) - ?? var0 - ? - var0 := FT_AEMAXLEN( ATail( myarray1 ) ) - ? PadR( "FT_AEMAXLEN( aTail( myarray1 ) ) ->", 30 ) - ?? var0 - ? - - RETURN - -#endif - FUNCTION FT_AEmaxlen( aArray, nDimension, nStart, nCount ) LOCAL i, nLast, cType, nMaxlen := 0 diff --git a/harbour/contrib/hbnf/aeminlen.prg b/harbour/contrib/hbnf/aeminlen.prg index 1d7b3c1827..3dc97a36d0 100644 --- a/harbour/contrib/hbnf/aeminlen.prg +++ b/harbour/contrib/hbnf/aeminlen.prg @@ -21,41 +21,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL var0, myarray1 := Directory() - - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AEMINLEN" - ? - ? "myarray1 := DIRECTORY()" - ? - 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 - ? - var0 := FT_AEMINLEN( myarray1, 2 ) - ? PadR( "FT_AEMINLEN( myarray1, 2 ) ->", 30 ) - ?? var0 - ? - ? - var0 := FT_AEMINLEN( myarray1[ 2 ] ) - ? PadR( "FT_AEMINLEN( myarray1[ 2 ] ) ->", 30 ) - ?? var0 - ? - ? - var0 := FT_AEMINLEN( myarray1, 3 ) - ? PadR( "FT_AEMINLEN( myarray1, 3 ) ->", 30 ) - ?? var0 - ? - - RETURN - -#endif - FUNCTION FT_AEminlen( aArray, nDimension, nStart, nCount ) LOCAL i, nLast, cType, nMinlen := 65519 diff --git a/harbour/contrib/hbnf/amedian.prg b/harbour/contrib/hbnf/amedian.prg index cb600ecb3b..d85e611c46 100644 --- a/harbour/contrib/hbnf/amedian.prg +++ b/harbour/contrib/hbnf/amedian.prg @@ -23,39 +23,6 @@ * */ -#ifdef FT_TEST - -#include "directry.ch" - -PROCEDURE Main() - - LOCAL var0, myarray0 := Directory(), myarray1 := {} - - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AMEDIAN" - ? - AEval( myarray0, {| x | AAdd( myarray1, x[ F_SIZE ] ) } ) - var0 := FT_AMEDIAN( myarray1 ) - ? PadR( "FT_AMEDIAN( myarray1 ) ->", 35 ) - ?? var0 - ? - var0 := FT_AMEDIAN( myarray1, 2 ) - ? PadR( "FT_AMEDIAN( myarray1, 2 ) ->", 35 ) - ?? var0 - ? - var0 := FT_AMEDIAN( myarray1, , 9 ) - ? PadR( "FT_AMEDIAN( myarray1, , 9 ) ->", 35 ) - ?? var0 - ? - var0 := FT_AMEDIAN( myarray1, 8, 40 ) - ? PadR( "FT_AMEDIAN( myarray1, 8, 40 ) ->", 35 ) - ?? var0 - ? - - RETURN - -#endif - #include "common.ch" #define FORCE_BETWEEN( x, y, z ) ( y := MAX( MIN( y, z ), x ) ) diff --git a/harbour/contrib/hbnf/aredit.prg b/harbour/contrib/hbnf/aredit.prg index ee7c91c092..d2e0ca491a 100644 --- a/harbour/contrib/hbnf/aredit.prg +++ b/harbour/contrib/hbnf/aredit.prg @@ -50,73 +50,6 @@ #define KEY_ELEM 1 #define BLK_ELEM 2 -#ifdef FT_TEST - -PROCEDURE Main() - - // Thanks to Jim Gale for helping me understand the basics - LOCAL i, ar[ 3, 26 ], aBlocks[ 3 ], aHeadings, nElem := 1, bGetFunc, cRet - // set up 2 dimensional array ar[] - FOR i := 1 TO 26 - ar[ 1, i ] := i // 1 -> 26 Numeric - ar[ 2, i ] := Chr( Asc( "A" ) + i - 1 ) // "A" -> "Z" Character - ar[ 3, i ] := Chr( Asc( "Z" ) - i + 1 ) // "Z" -> "A" Character - NEXT i - // Set Up aHeadings[] for column headings - aHeadings := { "Numbers", "Letters", "Reverse" } - // Set Up Blocks Describing Individual Elements in Array ar[] - aBlocks[ 1 ] := {|| Str( ar[ 1, nElem ], 2 ) } // to prevent default 10 spaces - aBlocks[ 2 ] := {|| ar[ 2, nElem ] } - aBlocks[ 3 ] := {|| ar[ 3, nElem ] } - // Set up TestGet() as bGetFunc - bGetFunc := {| b, ar, nDim, nElem | TestGet( b, ar, nDim, nElem ) } - - SET SCOREBOARD OFF - SetColor( "W/N" ) - CLS - @ 21, 4 SAY "Use Cursor Keys To Move Between Fields, = Delete Row, = Add Row" - @ 22, 7 SAY " = Quit Array Edit, or Edits Element" - SetColor( "N/W, W/N, , , W/N" ) - cRet := FT_ArEdit( 3, 5, 18, 75, ar, @nElem, aHeadings, aBlocks, bGetFunc ) - SetColor( "W/N" ) - CLS - ? cRet - ? "Lastkey() = ESC:", LastKey() == K_ESC - - RETURN - -FUNCTION TestGet( b, ar, nDim, nElem ) - - LOCAL GetList := {} - LOCAL nRow := Row() - LOCAL nCol := Col() - LOCAL cSaveScrn := SaveScreen( 21, 0, 22, MaxCol() ) - LOCAL cOldColor := SetColor( "W/N" ) - - @ 21, 0 CLEAR TO 22, MaxCol() - @ 21, 29 SAY "Editing Array Element" - SetColor( cOldColor ) - DO CASE - CASE nDim == 1 - @ nRow, nCol GET ar[ 1, nElem ] PICTURE "99" - READ - b:refreshAll() - CASE nDim == 2 - @ nRow, nCol GET ar[ 2, nElem ] PICTURE "!" - READ - b:refreshAll() - CASE nDim == 3 - @ nRow, nCol GET ar[ 3, nElem ] PICTURE "!" - READ - b:refreshAll() - ENDCASE - RestScreen( 21, 0, 22, MaxCol(), cSaveScrn ) - @ nRow, nCol SAY "" - - RETURN .T. - -#endif - FUNCTION FT_ArEdit( nTop, nLeft, nBot, nRight, ; ar, nElem, aHeadings, aBlocks, bGetFunc ) diff --git a/harbour/contrib/hbnf/at2.prg b/harbour/contrib/hbnf/at2.prg index d2d24f51bb..7e7196ff7d 100644 --- a/harbour/contrib/hbnf/at2.prg +++ b/harbour/contrib/hbnf/at2.prg @@ -26,37 +26,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL cSearch, cTarget, var0 - - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AT2" - ? - cSearch := "t" - ? "Find occurrences of 't' in: " - cTarget := "This is the day that the Lord has made." - ?? cTarget - ? - var0 := ft_at2( cSearch, cTarget ) - ? PadR( "FT_AT2( cSearch, cTarget ) -> ", 40 ) - ?? var0 - ? - var0 := ft_at2( cSearch, cTarget, 2 ) - ? PadR( "FT_AT2( cSearch, cTarget, 2 ) -> ", 40 ) - ??var0 - ? - var0 := ft_at2( cSearch, cTarget, 2, .F. ) - ? PadR( "FT_AT2( cSearch, cTarget, 2, .F. ) -> ", 40 ) - ??var0 - ? - - RETURN - -#endif - FUNCTION FT_AT2( cSearch, cTarget, nOccurs, lCaseSens ) LOCAL nCount, nPos, nPos2 := 0 diff --git a/harbour/contrib/hbnf/blink.prg b/harbour/contrib/hbnf/blink.prg index 7480418b0f..4f3b4253f7 100644 --- a/harbour/contrib/hbnf/blink.prg +++ b/harbour/contrib/hbnf/blink.prg @@ -23,16 +23,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main() - - FT_BLINK( "WAIT", 5, 10 ) - - RETURN - -#endif - FUNCTION FT_BLINK( cMsg, nRow, nCol ) // Declare color restore var. diff --git a/harbour/contrib/hbnf/calendar.prg b/harbour/contrib/hbnf/calendar.prg index b36d51c5dc..34b090eb91 100644 --- a/harbour/contrib/hbnf/calendar.prg +++ b/harbour/contrib/hbnf/calendar.prg @@ -23,32 +23,6 @@ #include "inkey.ch" #include "setcurs.ch" -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL aRet - - SetColor( "w+/b" ) - CLS - IF ft_numlock() - ft_numlock( .F. ) - ENDIF - hb_keyPut( K_F1 ) - 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 - -#endif - FUNCTION FT_CALENDAR( nRow, nCol, cColor, lShadow, lShowHelp ) LOCAL nJump := 0, nKey := 0, cSavColor, cSaveScreen, cSaveCursor diff --git a/harbour/contrib/hbnf/clrsel.prg b/harbour/contrib/hbnf/clrsel.prg index 266f3d08ff..784e91a3b6 100644 --- a/harbour/contrib/hbnf/clrsel.prg +++ b/harbour/contrib/hbnf/clrsel.prg @@ -92,59 +92,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main( cVidMode ) - - LOCAL nRowDos := Row() - LOCAL nColDos := Col() - LOCAL aEnvDos := FT_SaveSets() - LOCAL cScrDos := SaveScreen( 0, 0, MaxRow(), MaxCol() ) - LOCAL lColour - LOCAL aClrs - - DEFAULT cVidMode TO "" - NoSnow( ( "NOSNOW" $ Upper( cVidMode ) ) ) - IF "VGA" $ Upper( cVidMode ) - SetMode( 50, 80 ) - ENDIF - IF "EGA" $ Upper( cVidMode ) - SetMode( 43, 80 ) - ENDIF - lColour := iif( "MONO" $ Upper( cVidMode ), .F. , IsColor() ) - - SET SCOREBOARD OFF - SetCursor( SC_NONE ) - SetBlink( .F. ) - - //.... a typical application might have the following different settings - // normally these would be stored in a .dbf/.dbv - aClrs := { ; - { "Desktop", "N/BG", "D", hb_UTF8ToStr( "▒" ) }, ; - { "Title", "N/W", "T" }, ; - { "Top Menu", "N/BG,N/W,W+/BG,W+/N,GR+/N", "M" }, ; - { "Sub Menu", "W+/N*,GR+/N*,GR+/N*,W+/R,G+/R", "M" }, ; - { "Standard Gets", "W/B, W+/N,,, W/N", "G" }, ; - { "Nested Gets", "N/BG, W+/N,,, W/N", "G" }, ; - { "Help", "N/G, W+/N,,, W/N", "W" }, ; - { "Error Messages", "W+/R*,N/GR*,,,N/R*", "W" }, ; - { "Database Query", "N/BG, N/GR*,,,N+/BG", "B" }, ; - { "Pick List", "N/GR*,W+/B,,, BG/GR*", "A" } } - - aClrs := FT_ClrSel( aClrs, lColour ) - - HB_SYMBOL_UNUSED( aClrs ) - - //.... restore the DOS environment - FT_RestSets( aEnvDos ) - RestScreen( 0, 0, MaxRow(), MaxCol(), cScrDos ) - SetPos( nRowDos, nColDos ) - SetBlink( .F. ) // doesn't appear to be reset from FT_RestSets - - RETURN - -#endif - //------------------------------------------------ FUNCTION FT_ClrSel( aClrs, lColour, cChr ) diff --git a/harbour/contrib/hbnf/d2e.prg b/harbour/contrib/hbnf/d2e.prg index d5f56a770d..82f8126875 100644 --- a/harbour/contrib/hbnf/d2e.prg +++ b/harbour/contrib/hbnf/d2e.prg @@ -28,17 +28,6 @@ #define log10( num ) log( num ) / log( 10 ) #define DEFAULT_PRECISION 6 -#ifdef FT_TEST - -PROCEDURE Main( cNum, cPrec ) - - DEFAULT cPrec TO Str( DEFAULT_PRECISION ) - QOut( ft_d2e( Val( cNum ), Val( cPrec ) ) ) - - RETURN - -#endif - FUNCTION ft_d2e( nDec, nPrecision ) LOCAL nExp, sScn diff --git a/harbour/contrib/hbnf/datecnfg.prg b/harbour/contrib/hbnf/datecnfg.prg index e8a57071d3..60502faa77 100644 --- a/harbour/contrib/hbnf/datecnfg.prg +++ b/harbour/contrib/hbnf/datecnfg.prg @@ -26,210 +26,6 @@ * */ -#ifdef FT_TEST - -//******************************************************************* -// -// NOTES: 1) The date functions are 'international'; i.e., the -// system date format is maintained, although ANSI is -// temporarily used within certain functions. -// -// 2) The date functions fall into two categories: -// -// a) Calendar or fiscal periods. -// A calendar or fiscal year is identified by the year() -// of the last date in the year. -// -// b) Accounting Periods. An accounting period has the -// following characteristics: -// If the first week of the period contains 4 or -// more 'work' days, it is included in the period; -// otherwise, the first week was included in the -// prior period. -// -// If the last week of the period contains 4 or more -// 'work' days it is included in the period; otherwise, -// the last week is included in the next period. -// This results in 13 week 'quarters' and 4 or 5 week -// 'months'. Every 5 or 6 years, a 'quarter' will contain -// 14 weeks and the year will contain 53 weeks. -// -// 3) The date functions require the presence of two variables: -// -// a) cFY_Start is a character string used to define the -// first day of a calendar or fiscal year. It's format -// is ANSI; e.g., "1980.01.01" defines a calendar year, -// "1980.10.01" defines a fiscal year, starting October 1. -// -// The year may be any valid year. It's value has no -// effect on the date functions. The day is assumed to be -// less than 29. See function: FT_DATECNFG(). -// -// B) nDow_Start is a number from 1 to 7 which defines the -// starting day, DOW(), of a work week; e.g., 1 == Sunday. -// -// See function: FT_DATECNFG() -// -// COMPILE ALL PROGRAMS WITH /N /W /A -// -//******************************************************************* - -PROCEDURE Main() - - 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. - dDate := Date() -// dDate := SToD( "19880229" ) // Test date, in user's normal date format - - CLS - ? "Given Date: " - ?? dDate - ?? " cFY_Start: " + cFY_Start - ?? " nDOW_Start:" + Str( nDOW_Start, 2 ) - ? "---- Fiscal Year Data -----------" - - aTestData := FT_YEAR( dDate ) - ? "FYYear ", aTestData[ 1 ] + " ", aTestData[ 2 ], aTestData[ 3 ] - - aTestData := FT_QTR( dDate ) - ? "FYQtr ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] - - nNum := Val( SubStr( aTestData[ 1 ], 5, 2 ) ) - aTestData := FT_QTR( dDate, nNum ) - ? "FYQtr " + Str( nNum, 2 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] - - aTestData := FT_MONTH( dDate ) - ? "FYMonth ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] - - nNum := Val( SubStr( aTestData[ 1 ], 5, 2 ) ) - aTestData := FT_MONTH( dDate, nNum ) - ? "FYMonth " + Str( nNum, 2 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] - - aTestData := FT_WEEK( dDate ) - ? "FYWeek ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] - - nNum := Val( SubStr( aTestData[ 1 ], 5, 2 ) ) - aTestData := FT_WEEK( dDate, nNum ) - ? "FYWeek " + Str( nNum, 2 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] - - aTestData := FT_DAYOFYR( dDate ) - ? "FYDay ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] - - nNum := Val( SubStr( aTestData[ 1 ], 5, 3 ) ) - aTestData := FT_DAYOFYR( dDate, nNum ) - ? "FYDAY " + Str( nNum, 3 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] - - ? - ? "---- Accounting Year Data -------" - - aTestData := FT_ACCTYEAR( dDate ) - ? "ACCTYear ", aTestData[ 1 ] + " ", aTestData[ 2 ], aTestData[ 3 ], ; - Str( ( aTestData[ 3 ] - aTestData[ 2 ] + 1 ) / 7, 3 ) + " Weeks" - - aTestData := FT_ACCTQTR( dDate ) - ? "ACCTQtr ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ], ; - Str( ( aTestData[ 3 ] - aTestData[ 2 ] + 1 ) / 7, 3 ) + " Weeks" - - nNum := Val( SubStr( aTestData[ 1 ], 5, 2 ) ) - aTestData := FT_ACCTQTR( dDate, nNum ) - ? "ACCTQtr " + Str( nNum, 2 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] - - aTestData := FT_ACCTMONTH( dDate ) - ? "ACCTMonth ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ], ; - Str( ( aTestData[ 3 ] - aTestData[ 2 ] + 1 ) / 7, 3 ) + " Weeks" - - nNum := Val( SubStr( aTestData[ 1 ], 5, 2 ) ) - aTestData := FT_ACCTMONTH( dDate, nNum ) - ? "ACCTMonth" + Str( nNum, 2 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] - - aTestData := FT_ACCTWEEK( dDate ) - ? "ACCTWeek ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] - - nNum := Val( SubStr( aTestData[ 1 ], 5, 2 ) ) - aTestData := FT_ACCTWEEK( dDate, nNum ) - ? "ACCTWeek " + Str( nNum, 2 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] - - aTestData := FT_DAYOFYR( dDate, , .T. ) - ? "ACCTDay ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] - - nNum := Val( SubStr( aTestData[ 1 ], 5, 3 ) ) - aTestData := FT_DAYOFYR( dDate, nNum, .T. ) - ? "ACCTDay " + Str( nNum, 3 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] - - WAIT - - FT_CAL( dDate ) - FT_CAL( dDate, 1 ) - - RETURN - -// DEMO Monthly Calendar function. -// nType : 0 -> FT_MONTH, 1 -> FT_ACCTMONTH - -STATIC FUNCTION FT_CAL( dGivenDate, nType ) - - LOCAL nTemp, dTemp, aTemp, cFY_Start, dStart, dEnd - - aTemp := FT_DATECNFG() - cFY_Start := aTemp[ 1 ] - - IF dGivenDate == NIL .OR. !( ValType( dGivenDate ) $ "ND" ) - dGivenDate := Date() - ELSEIF HB_ISNUMERIC( dGivenDate ) - nType := dGivenDate - dGivenDate := Date() - ENDIF - - nType := iif( HB_ISNUMERIC( nType ), nType, 0 ) - - IF nType == 0 - IF SubStr( cFY_Start, 6, 5 ) == "01.01" - ? " Calendar Month Calendar containing " + DToC( dGivenDate ) - ELSE - ? " Fiscal Month Calendar containing " + DToC( dGivenDate ) - ENDIF - - aTemp := FT_MONTH( dGivenDate ) - dStart := aTemp[ 2 ] - dEnd := aTemp[ 3 ] - aTemp[ 2 ] -= FT_DAYTOBOW( aTemp[ 2 ] ) - aTemp[ 3 ] += 6 - FT_DAYTOBOW( aTemp[ 3 ] ) - ELSE - ? " Accounting Month Calendar containing " + DToC( dGivenDate ) - aTemp := FT_ACCTMONTH( dGivenDate ) - ENDIF - - ? - dTemp := aTemp[ 2 ] - - FOR nTemp := 0 TO 6 - ?? PadC( CDOW( dTemp + nTemp ), 10 ) - NEXT - - ? - WHILE dTemp <= aTemp[ 3 ] - FOR nTemp := 1 TO 7 - ?? " " - IF nType == 0 .AND. ( dTemp < dStart .OR. dTemp > dEnd ) - ?? Space( 8 ) - ELSE - ?? dTemp - ENDIF - ?? " " - dTemp++ - NEXT - ? - END - - RETURN NIL - -#endif - FUNCTION FT_DATECNFG( cFYStart , nDow ) THREAD STATIC t_aDatePar := { "1980.01.01", 1 } diff --git a/harbour/contrib/hbnf/dectobin.prg b/harbour/contrib/hbnf/dectobin.prg index 3020f610f6..6e5521cfc5 100644 --- a/harbour/contrib/hbnf/dectobin.prg +++ b/harbour/contrib/hbnf/dectobin.prg @@ -23,20 +23,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL X - - FOR X := 1 TO 255 - QOut( FT_DEC2BIN( x ) ) - NEXT - - RETURN - -#endif - FUNCTION FT_DEC2BIN( x ) LOCAL i, buffer := { "0", "0", "0", "0", "0", "0", "0", "0" } diff --git a/harbour/contrib/hbnf/dfile.prg b/harbour/contrib/hbnf/dfile.prg index 6e51b4ae7f..a5b8ef7da5 100644 --- a/harbour/contrib/hbnf/dfile.prg +++ b/harbour/contrib/hbnf/dfile.prg @@ -28,59 +28,6 @@ THREAD STATIC t_nHandle := 0 -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL cInFile := "dfile.prg" - LOCAL CKEY - LOCAL NNCOLOR := 7 - LOCAL NHCOLOR := 15 - LOCAL NCOLSKIP := 5 - LOCAL NRMARGIN := 132 - LOCAL CEXITKEYS := "AABBC " - LOCAL LBROWSE := .F. - LOCAL NSTART := 1 - LOCAL NBUFFSIZE := 4096 - LOCAL GetList := {} - - @ 0, 0 CLEAR - - @ 0, 0 SAY "ENTER FILENAME: " GET CINFILE - @ 1, 0 SAY " FOREGROUND: " GET NNCOLOR PICTURE "999" - @ 2, 0 SAY " HIGHLIGHT: " GET NHCOLOR PICTURE "999" - @ 3, 0 SAY " EXIT KEYS: " GET CEXITKEYS - @ 4, 0 SAY " BUFFER SIZE: " GET NBUFFSIZE PICTURE "9999" - @ 1, 40 SAY "COLUMN INCREMENT: " GET NCOLSKIP PICTURE "999" - @ 2, 40 SAY " MAX LINE SIZE: " GET NRMARGIN PICTURE "999" - @ 3, 40 SAY " BROWSE MODE? " GET LBROWSE PICTURE "Y" - - READ - - /* - * REMEMBER A WINDOW WILL BE ONE SIZE LESS AND GREATER THAN THE PASSED COORD.'S - * - * THE 9TH PARAMETER CONTAINS THE KEYS THAT THE ROUTINE WILL TERMINATE ON - * AND THE hb_BChar(143) represents the F3 key. - * - */ - - @ 4, 9 TO 11, 71 - - FT_DFSETUP( cInFile, 5, 10, 10, 70, nStart, ; - nNColor, nHColor, cExitKeys + hb_BChar( 143 ), ; - lBrowse, nColSkip, nRMargin, nBuffSize ) - - cKey := FT_DISPFILE() - - FT_DFCLOSE() - - @ 20, 0 SAY "Key pressed was: " + "[" + cKey + "]" - - RETURN - -#endif - FUNCTION FT_DFSETUP( cInFile, nTop, nLeft, nBottom, nRight, ; nStart, nCNormal, nCHighlight, cExitKeys, ; lBrowse, nColSkip, nRMargin, nBuffSize ) diff --git a/harbour/contrib/hbnf/diskfunc.prg b/harbour/contrib/hbnf/diskfunc.prg index 489437eb96..b50914ae17 100644 --- a/harbour/contrib/hbnf/diskfunc.prg +++ b/harbour/contrib/hbnf/diskfunc.prg @@ -29,17 +29,6 @@ #define DRVTABLE "ABCDEFGHIJKLMNOPQRSTUVWXYZ" -#ifdef FT_TEST - -PROCEDURE Main( cDrv ) - - QOut( "Disk size: " + Str( FT_DSKSIZE( cDrv ) ) ) - QOut( "Free bytes: " + Str( FT_DSKFREE( cDrv ) ) ) - - RETURN - -#endif - FUNCTION FT_DSKSIZE( cDrive ) RETURN DiskSpace( iif( cDrive == NIL, 0, At( Upper( cDrive ), DRVTABLE ) ), HB_DISK_TOTAL ) diff --git a/harbour/contrib/hbnf/dispmsg.prg b/harbour/contrib/hbnf/dispmsg.prg index 316095b7d1..05aaa51663 100644 --- a/harbour/contrib/hbnf/dispmsg.prg +++ b/harbour/contrib/hbnf/dispmsg.prg @@ -30,70 +30,6 @@ #include "setcurs.ch" // beginning of demo program -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL cDosScrn - LOCAL nDosRow - LOCAL nDosCol - LOCAL lColor - LOCAL nMaxRow - LOCAL nType - - // color variables - LOCAL cNormH, cNormN - LOCAL cWindH, cWindN - LOCAL cErrH, cErrN - - // main routine starts here - SET SCOREBOARD OFF - - lColor := .T. - - cNormH := iif( lColor, "W+/BG", "W+/N" ) - cNormN := iif( lColor, "N/BG" , "W/N" ) - cWindH := iif( lColor, "W+/B", "W+/N" ) - cWindN := iif( lColor, "W/B" , "W/N" ) - cErrH := iif( lColor, "W+/R", "W+/N" ) - cErrN := iif( lColor, "W/R" , "W/N" ) - - cDosScrn := SaveScreen() - nDosRow := Row() - nDosCol := Col() - SetColor( "W/N" ) - CLS - nMaxRow := MaxRow() - SetBlink( .F. ) - SetColor( cWindN + "*" ) - CLS - SetColor( cNormN ) - - FT_DispMsg( { { "[Esc] To Abort Changes [PgDn] To Continue" }, { cNormN, , cNormH } }, , nMaxRow - 5 ) - - FT_DispMsg( { { "[E]dit [P]rint [D]elete", ; - "[Esc]ape [Alt-Q]" }, ; - { cErrN, cErrN, cErrH } }, , 2 ) - - nType := FT_DispMsg( { { ; - "Create Or Edit [I]nvoice" ,; - "Create Or Edit [O]rder" ,; - "Create Or Edit [B]ack Order" ,; - "Create Or Edit [Q]uote" ,; - "[Esc] To Exit" } ,; - { cWindN, , , , , cWindH } }, "BIOQ" + Chr( K_ESC ) ) - - HB_SYMBOL_UNUSED( nType ) - - SetColor( "W/N" ) - SetCursor( SC_NORMAL ) - SetBlink( .T. ) - RestScreen( , , , , cDosScrn ) - SetPos( nDosRow, nDosCol ) - QUIT - -#endif - FUNCTION FT_DispMsg( aInfo, cKey, nBoxTop, nBoxLeft, cnBoxString, lShadow ) LOCAL xRtnVal := .F. diff --git a/harbour/contrib/hbnf/dosver.prg b/harbour/contrib/hbnf/dosver.prg index 501fa115c3..39a214860d 100644 --- a/harbour/contrib/hbnf/dosver.prg +++ b/harbour/contrib/hbnf/dosver.prg @@ -29,16 +29,6 @@ #define DOS 33 #define DOSVER 48 -#ifdef FT_TEST - -PROCEDURE Main() - - QOut( "Dos version: " + FT_DOSVER() ) - - RETURN - -#endif - FUNCTION FT_DOSVER() // LOCAL aRegs[ INT86_MAX_REGS ] diff --git a/harbour/contrib/hbnf/e2d.prg b/harbour/contrib/hbnf/e2d.prg index dca96adf1c..0b555acedb 100644 --- a/harbour/contrib/hbnf/e2d.prg +++ b/harbour/contrib/hbnf/e2d.prg @@ -23,16 +23,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main( sNumE ) - - QOut( FT_E2D( sNumE ) ) - - RETURN - -#endif - FUNCTION ft_e2d( sNumE ) LOCAL nMant, nExp diff --git a/harbour/contrib/hbnf/elapsed.prg b/harbour/contrib/hbnf/elapsed.prg index 20f19abbd4..7c9659199a 100644 --- a/harbour/contrib/hbnf/elapsed.prg +++ b/harbour/contrib/hbnf/elapsed.prg @@ -26,28 +26,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL dStart, dEnd, cTimeStart, cTimeEnd, n, aDataTest - - dStart := SToD( "19901128" ) - dEnd := SToD( "19901130" ) - cTimeStart := "08:00:00" - cTimeEnd := "12:10:30" - - aDataTest := FT_ELAPSED( dStart, dEnd, cTimeStart, cTimeEnd ) - 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." ) ) ) - NEXT - - RETURN - -#endif - FUNCTION FT_ELAPSED( dStart, dEnd, cTimeStart, cTimeEnd ) LOCAL nTotalSec, nCtr, nConstant, nTemp, aRetVal[ 4, 2 ] diff --git a/harbour/contrib/hbnf/findith.prg b/harbour/contrib/hbnf/findith.prg index 7b29eb1d44..91d15c55be 100644 --- a/harbour/contrib/hbnf/findith.prg +++ b/harbour/contrib/hbnf/findith.prg @@ -26,29 +26,6 @@ #define MAKE_UPPER( cString ) ( cString := UPPER( cString ) ) #define NULL "" -#ifdef FT_TEST - -PROCEDURE Main( cCk, cStr, nOcc, xCase ) - - LOCAL nFind - - IF PCount() != 4 - QOut( "usage: findith cCk cStr nOcc xCase" ) - QUIT - ENDIF - - xCase := iif( xCase == "Y", .T. , .F. ) - nOcc := Val( nOcc ) - QOut( iif( xCase, "Ignoring ", "Observing " ) + "case:" ) - - QOut( cStr ) - nFind := FT_FINDITH( cCk, cStr, nOcc, xCase ) - QOut( iif( nFind > 0, Space( nFind - 1 ) + "^" , "Not found" ) ) - - RETURN - -#endif - FUNCTION FT_FINDITH( cCheckFor, cCheckIn, nWhichOccurrence, lIgnoreCase ) LOCAL nIthOccurrence diff --git a/harbour/contrib/hbnf/floptst.prg b/harbour/contrib/hbnf/floptst.prg index 8da5eb67a5..bae27465d7 100644 --- a/harbour/contrib/hbnf/floptst.prg +++ b/harbour/contrib/hbnf/floptst.prg @@ -44,23 +44,6 @@ #define ERR_WRITE_PROTECTED 3 #define ERR_UNKNOWN 4 -#ifdef FT_TEST - -PROCEDURE Main( cArg1 ) - - LOCAL nErrCode - - IF HB_ISSTRING( cArg1 ) - nErrCode := FT_FLOPTST( Asc( Upper( cArg1 ) ) - Asc( "A" ) ) - OutStd( "Return Code is " + hb_ntos( nErrCode ) + hb_eol() ) - ELSE - OutStd( "Usage: floptst cDrive" + hb_eol() + " where cDrive is 'A' or 'B' etc..." + hb_eol() ) - ENDIF - - RETURN - -#endif - // error code defined by ERR_* FUNCTION FT_FLOPTST( nDriveNum_i /* letter of floppy drive */ ) LOCAL cBuffer diff --git a/harbour/contrib/hbnf/gcd.prg b/harbour/contrib/hbnf/gcd.prg index 2b532e8291..e8ee3c2de5 100644 --- a/harbour/contrib/hbnf/gcd.prg +++ b/harbour/contrib/hbnf/gcd.prg @@ -23,16 +23,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main( cNum1, cNum2 ) - - OutStd( Str( FT_GCD( Val( cNum1 ), Val( cNum2 ) ) ) + hb_eol() ) - - RETURN - -#endif - FUNCTION FT_GCD( nNumber1, nNumber2 ) LOCAL nHold1 // Temporarily Hold the Maximum Number diff --git a/harbour/contrib/hbnf/hbmk.hbm b/harbour/contrib/hbnf/hbmk.hbm deleted file mode 100644 index 9ac760c101..0000000000 --- a/harbour/contrib/hbnf/hbmk.hbm +++ /dev/null @@ -1,9 +0,0 @@ -# -# $Id$ -# - -hbnf.hbc - --w3 -es2 - --DFT_TEST diff --git a/harbour/contrib/hbnf/hex2dec.prg b/harbour/contrib/hbnf/hex2dec.prg index 0438d52481..390f1e9be8 100644 --- a/harbour/contrib/hbnf/hex2dec.prg +++ b/harbour/contrib/hbnf/hex2dec.prg @@ -28,16 +28,6 @@ #define HEXTABLE "0123456789ABCDEF" -#ifdef FT_TEST - -PROCEDURE Main( cHexNum ) - - QOut( FT_HEX2DEC( cHexNum ) ) - - RETURN - -#endif - FUNCTION FT_HEX2DEC( cHexNum ) LOCAL n, nDec := 0, nHexPower := 1 diff --git a/harbour/contrib/hbnf/isshare.prg b/harbour/contrib/hbnf/isshare.prg index b3987e8af2..8e75e93a94 100644 --- a/harbour/contrib/hbnf/isshare.prg +++ b/harbour/contrib/hbnf/isshare.prg @@ -29,27 +29,6 @@ #include "ftint86.ch" -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL nLoaded := ft_isshare() - - DO CASE - CASE nLoaded == 0 - QOut( "Share not loaded, but ok to load" ) - CASE nLoaded == 1 - QOut( "Share not loaded, but NOT ok to load!" ) - CASE nLoaded == 255 - QOut( "Share is loaded!" ) - ENDCASE - - QOut( "Retcode: " + Str( nLoaded ) ) - - RETURN - -#endif - FUNCTION ft_isshare() /* LOCAL aRegs[ INT86_MAX_REGS ] // Declare the register array diff --git a/harbour/contrib/hbnf/linked.prg b/harbour/contrib/hbnf/linked.prg index c3d2bb0524..bca69bbcdf 100644 --- a/harbour/contrib/hbnf/linked.prg +++ b/harbour/contrib/hbnf/linked.prg @@ -23,33 +23,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL aString := { ; - "RTrim('abc ')" ,; - "NotARealFunc()" ,; - "FT_DispMsg()" ,; - 'RTrim(cVar+"abc"+Left(cString)), Found()' ,; - "IsItLinked()" ,; - "lRetVal := Found()" ,; - "!EOF() .AND. Month(Date())=12 .AND. YeeHa()" ,; - "!EOF() .AND. Month(Date())=12" ,; - "!EOF() .AND. Month(Date(YeeHa()))=12" ,; - "Left(SubStr(nNum,4,Val(cChar+Asc(c))))" ,; - "EOF(>> Note: Syntax IS NOT checked! <<)" } - - CLS - @ 1, 0 SAY "String Tested Result" - @ 2, 0 TO 2, MaxCol() - AEval( aString, {| ele | QOut( ele, Space( 45 - Len( ele ) ), FT_Linked( ele ) ) } ) - @ MaxRow() - 2, 0 - - RETURN - -#endif - // A function is detected by the left parenthesis, "(", and it begins // at the space, comma or start-of-string preceeding the "(" diff --git a/harbour/contrib/hbnf/menu1.prg b/harbour/contrib/hbnf/menu1.prg index 1098217765..771892f73d 100644 --- a/harbour/contrib/hbnf/menu1.prg +++ b/harbour/contrib/hbnf/menu1.prg @@ -49,137 +49,6 @@ THREAD STATIC t_nVPos THREAD STATIC t_nMaxRow THREAD STATIC t_nMaxCol -// BEGINNING OF DEMO PROGRAM -#ifdef FT_TEST -// DUMMY PROCEDURE NAME SO "CCMDLINE" WILL BE LOCAL - -PROCEDURE Main( cCmdLine ) - - LOCAL sDosScrn, nDosRow, nDosCol, lColor - - // my approach to color variables - // see colorchg.arc on NANFORUM - LOCAL cNormN - LOCAL cWindN - LOCAL cErrH - LOCAL cErrN - - // options on menu bar - LOCAL aColors - LOCAL aBar := { " ENTER/EDIT ", " REPORTS ", " DISPLAY ", " MAINTENANCE ", " QUIT " } - LOCAL aOptions[ Len( aBar ) ] - AEval( aBar, {| x, i | HB_SYMBOL_UNUSED( x ), aOptions[ i ] := { {}, {}, {} } } ) - - cCmdLine := iif( cCmdLine == NIL, "", cCmdLine ) - - lColor := iif( "MONO" $ Upper( cCmdLine ), .F. , IsColor() ) - - // Border, Box, Bar, Current, Unselected - 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[ 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[ 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. ) - - // main routine starts here - SET SCOREBOARD OFF - - cNormN := iif( lColor, "N/G" , "W/N" ) - cWindN := iif( lColor, "W/B" , "W/N" ) - cErrH := iif( lColor, "W+/R", "W+/N" ) - cErrN := iif( lColor, "W/R" , "W/N" ) - - SAVE SCREEN TO sDosScrn - nDosRow := Row() - nDosCol := Col() - SetColor( "w/n" ) - CLS - NoSnow( "NOSNOW" $ Upper( cCmdLine ) ) - IF "VGA" $ Upper( cCmdLine ) - SetMode( 50, 80 ) - ENDIF - t_nMaxRow := MaxRow() - SetBlink( .F. ) - SetColor( cWindN + "*" ) - CLS - SetColor( cNormN ) - @ t_nMaxRow, 0 - @ t_nMaxRow, 0 SAY hb_UTF8ToStr( " FT_MENU1 1.0 │ " ) - @ t_nMaxRow, 16 SAY "WRITTEN BY PAUL FERRARA [76702,556] FOR NANFORUM.LIB" - @ t_nMaxRow, 69 SAY hb_UTF8ToStr( "│ " ) + DToC( Date() ) - - SetColor( cErrH ) - @ t_nMaxRow - 11, 23, t_nMaxRow - 3, 56 BOX hb_UTF8ToStr( "┌─┐│┘─└│ " ) - @ t_nMaxRow - 9, 23 SAY hb_UTF8ToStr( "├────────────────────────────────┤" ) - SetColor( cErrN ) - @ t_nMaxRow - 10, 33 SAY "Navigation Keys" - @ t_nMaxRow - 8, 25 SAY "LeftArrow RightArrow Alt-E" - @ t_nMaxRow - 7, 25 SAY "Home End Alt-R" - @ t_nMaxRow - 6, 25 SAY "Tab Shift-Tab Alt-D" - @ t_nMaxRow - 5, 25 SAY "PgUp PgDn Alt-M" - @ t_nMaxRow - 4, 25 SAY "Enter ESCape Alt-Q" - SetColor( cNormN ) - - FT_MENU1( aBar, aOptions, aColors ) - - SetColor( "W/N" ) - SetCursor( SC_NORMAL ) - SetBlink( .T. ) - IF "VGA" $ Upper( cCmdLine ) - SetMode( 25, 80 ) - ENDIF - RESTORE SCREEN FROM sDosScrn - SetPos( nDosRow, nDosCol ) - QUIT - -FUNCTION fubar() - - LOCAL OldColor := SetColor( "W/N" ) - - CLS - QOut( "Press Any Key" ) - Inkey( 0 ) - SetColor( OldColor ) - - RETURN .T. - -#endif - -// end of demo program - FUNCTION FT_MENU1( aBar, aOptions, aColors, nTopRow, lShadow ) LOCAL nTtlUsed diff --git a/harbour/contrib/hbnf/metaph.prg b/harbour/contrib/hbnf/metaph.prg index b438b2e235..be769f1710 100644 --- a/harbour/contrib/hbnf/metaph.prg +++ b/harbour/contrib/hbnf/metaph.prg @@ -91,107 +91,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL aNames := {} - - Set( _SET_SCOREBOARD, .F. ) - Set( _SET_COLOR, "W/B" ) - CLS - - // Demo will create an array of names and display in 3 columns - // _ftRow() and _ftCol() will calculate the screen co-ordinates - // by evaluating the element number - - AAdd( aNames, "Adams" ) - AAdd( aNames, "Addams" ) - AAdd( aNames, "Atoms" ) - AAdd( aNames, "Adamson" ) - AAdd( aNames, "Cajun" ) - AAdd( aNames, "Cagen" ) - AAdd( aNames, "Cochy" ) - AAdd( aNames, "Cocci" ) - AAdd( aNames, "Smith" ) - AAdd( aNames, "Smythe" ) - AAdd( aNames, "Naylor" ) - AAdd( aNames, "Nailer" ) - AAdd( aNames, "Holberry" ) - AAdd( aNames, "Wholebary" ) - AAdd( aNames, "Jackson" ) - AAdd( aNames, "Jekksen" ) - AAdd( aNames, "The Source" ) - AAdd( aNames, "The Sores" ) - AAdd( aNames, "Jones" ) - AAdd( aNames, "Johns" ) - AAdd( aNames, "Lennon" ) - AAdd( aNames, "Lenin" ) - AAdd( aNames, "Fischer" ) - AAdd( aNames, "Fisher" ) - AAdd( aNames, "O'Donnell" ) - AAdd( aNames, "O Donald" ) - AAdd( aNames, "Pugh" ) - AAdd( aNames, "Pew" ) - AAdd( aNames, "Heimendinger" ) - AAdd( aNames, "Hymendinker" ) - AAdd( aNames, "Knight" ) - AAdd( aNames, "Nite" ) - AAdd( aNames, "Lamb" ) - AAdd( aNames, "Lamb Chops" ) - AAdd( aNames, "Stephens" ) - AAdd( aNames, "Stevens" ) - AAdd( aNames, "Neilson" ) - AAdd( aNames, "Nelson" ) - AAdd( aNames, "Tchaikovski" ) - AAdd( aNames, "Chikofski" ) - AAdd( aNames, "Caton" ) - AAdd( aNames, "Wright" ) - AAdd( aNames, "Write" ) - AAdd( aNames, "Right" ) - AAdd( aNames, "Manual" ) - AAdd( aNames, "Now" ) - AAdd( aNames, "Wheatabix" ) - AAdd( aNames, "Science" ) - AAdd( aNames, "Cinzano" ) - AAdd( aNames, "Lucy" ) - AAdd( aNames, "Reece" ) - AAdd( aNames, "Righetti" ) - AAdd( aNames, "Oppermann" ) - AAdd( aNames, "Bookkeeper" ) - AAdd( aNames, "McGill" ) - AAdd( aNames, "Magic" ) - AAdd( aNames, "McLean" ) - AAdd( aNames, "McLane" ) - AAdd( aNames, "Maclean" ) - AAdd( aNames, "Exxon" ) - - // display names and metaphones in 3 columns on screen - AEval( aNames, ; - {| cName, nElem | ; - SetPos( _ftRow( nElem ), _ftCol( nElem ) ), ; - QQOut( PadR( cName, 18, "." ) + FT_METAPH( cName ) ) ; - } ) - - SetPos( 21, 00 ) - QUIT - -//------------------------------------------------ - -STATIC FUNCTION _ftRow( nElem ) // Determine which row to print on - - RETURN iif( nElem > 40, nElem - 40, iif( nElem > 20, nElem - 20, nElem ) ) - -//------------------------------------------------ - -STATIC FUNCTION _ftCol( nElem ) // Determine which column to start print - - RETURN iif( nElem > 40, 55, iif( nElem > 20, 28, 1 ) ) - -//------------------------------------------------ - -#endif - //------------------------------------------------ FUNCTION FT_METAPH( cName, nSize ) diff --git a/harbour/contrib/hbnf/miltime.prg b/harbour/contrib/hbnf/miltime.prg index f15ae0db57..4533f37f45 100644 --- a/harbour/contrib/hbnf/miltime.prg +++ b/harbour/contrib/hbnf/miltime.prg @@ -23,45 +23,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main() - - CLS - ? "am-pm" - ? ft_civ2mil( " 5:40 pm" ) - ? ft_civ2mil( "05:40 pm" ) - ? ft_civ2mil( " 5:40 PM" ) - ? ft_civ2mil( " 5:40 am" ) - ? ft_civ2mil( "05:40 am" ) - ? ft_civ2mil( " 5:40 AM" ) - ? - Inkey( 0 ) - CLS - ? "noon-midnight" - ? ft_civ2mil( "12:00 m" ) - ? ft_civ2mil( "12:00 M" ) - ? ft_civ2mil( "12:00 m" ) - ? ft_civ2mil( "12:00 n" ) - ? ft_civ2mil( "12:00 N" ) - ? ft_civ2mil( "12:00 n" ) - ? - Inkey( 0 ) - CLS - ? "errors in noon-midnight" - ? ft_civ2mil( "12:01 n" ) - ? ft_civ2mil( "22:00 n" ) - ? ft_civ2mil( "12:01 m" ) - ? ft_civ2mil( "22:00 n" ) - ? - ? "sys to mil" - ? Time() - ? ft_sys2mil() - - RETURN - -#endif - FUNCTION FT_MIL2MIN( cMILTIME ) RETURN Int( Val( Left( cMILTIME, 2 ) ) * 60 + Val( Right( cMILTIME, 2 ) ) ) diff --git a/harbour/contrib/hbnf/mouse1.prg b/harbour/contrib/hbnf/mouse1.prg index 44d6a370b9..86d3315f05 100644 --- a/harbour/contrib/hbnf/mouse1.prg +++ b/harbour/contrib/hbnf/mouse1.prg @@ -5,194 +5,6 @@ THREAD STATIC t_lCrsState := .F. THREAD STATIC t_lMinit := .F. -#ifdef FT_TEST - -PROCEDURE Main( nRow, nCol ) - - // Pass valid row and column values for different video modes to change modes - - LOCAL nX, nY, cSavClr - LOCAL cSavScr := SaveScreen( 0, 0, MaxRow(), MaxCol() ) - LOCAL nSaveRow := MaxRow() + 1, nSaveCol := MaxCol() + 1 - LOCAL nMinor, nType, nIRQ - LOCAL aType := { "Bus", "Serial", "InPort", "PS/2", "HP" } - LOCAL nHoriz, nVert, nDouble - - IF nRow == NIL - nRow := MaxRow() + 1 - ELSE - nRow := Val( nRow ) - ENDIF - - IF nCol == NIL - nCol := MaxCol() + 1 - ELSE - nCol := Val( nCol ) - ENDIF - - IF !FT_MINIT() - @ MaxRow(), 0 SAY "Mouse driver is not installed!" - - RETURN - ENDIF - - // ..... Set up the screen - cSavClr := SetColor( "w/n" ) - @ 0, 0, MaxRow(), MaxCol() BOX hb_UTF8ToStr( "░░░░░░░░░" ) - - SetColor( "GR+/RB" ) -// Scroll( 7, 2, 19, 63, 0 ) - @ 7, 2 TO 20, 63 - - @ 17, 10 TO 19, 40 double - - SetColor( "N/W" ) - @ 18, 11 SAY " Double Click here to Quit " - - SetColor( "GR+/RB" ) - - // ..... Start the demo - - @ MaxRow(), 0 SAY "Driver version: " + ; - AllTrim( Str( FT_MVERSION( @nMinor, @nType, @nIRQ ), 2, 0 ) ) + "." + ; - AllTrim( Str( nMinor, 2, 0 ) ) - @ Row(), Col() SAY " " + aType[ nType ] + " mouse using IRQ " + Str( nIRQ, 1, 0 ) - - FT_MGETSENS( @nHoriz, @nVert, @nDouble ) // Get the current sensitivities - FT_MSETSENS( 70, 70, 60 ) // Bump up the sensitivity of the mouse - - FT_MSHOWCRS() - FT_MSETCOORD( 10, 20 ) // just an arbitrary place for demo - - // put the unchanging stuff - - DevPos( 9, 10 ) - DevOut( "FT_MMICKEYS :" ) - - DevPos( 10, 10 ) - DevOut( "FT_MGETPOS :" ) - - DevPos( 11, 10 ) - DevOut( "FT_MGETX :" ) - - DevPos( 12, 10 ) - DevOut( "FT_MGETY :" ) - - DevPos( 13, 10 ) - DevOut( "FT_MGETCOORD:" ) - - DevPos( 14, 10 ) - DevOut( "FT_MBUTPRS :" ) - - DevPos( 16, 10 ) - DevOut( "FT_MBUTREL :" ) - - nX := nY := 1 - DO WHILE .T. - - // If we are not moving then wait for movement. - // This whole demo is a bit artificial in its requirements when compared - // to a "normal" CLIPPER program so some of these examples are a bit out of - // the ordinary. - - DO WHILE nX == 0 .AND. nY == 0 - FT_MMICKEYS( @nX, @nY ) - ENDDO - // tell the mouse driver where updates will be taking place so it can hide - // the cursor when necessary. - - FT_MCONOFF( 9, 23, 16, 53 ) - - DevPos( 9, 23 ) - DevOut( nX ) - DevOut( nY ) - - DevPos( 10, 23 ) - DevOut( FT_MGETPOS( @nX, @nY ) ) - DevOut( nX ) - DevOut( nY ) - - DevPos( 11, 23 ) - DevOut( FT_MGETX() ) - - DevPos( 12, 23 ) - DevOut( FT_MGETY() ) - - DevPos( 13, 23 ) - DevOut( FT_MGETCOORD( @nX, @nY ) ) - DevOut( nX ) - DevOut( nY ) - - nX := nY := 0 - DevPos( 14, 23 ) - DevOut( FT_MBUTPRS( 1 ) ) - DevOut( FT_MBUTPRS( 0,, nX, nY ) ) - DevPos( 15, 23 ) - - // show only the last Press since it flashes by so quickly - - IF nX != 0 .OR. nY != 0 - DevOut( nX ) - DevOut( nY ) - ENDIF - - nX := nY := 0 - DevPos( 16, 23 ) - DevOut( FT_MBUTREL( 0,, @nX, @nY ) ) - - // show only the last release since it flashes by so quickly - - IF nX != 0 .OR. nY != 0 - DevOut( nX ) - DevOut( nY ) - ENDIF - - // Restore the cursor if it has been hidden - - FT_MSHOWCRS() - - IF FT_MINREGION( 18, 11, 18, 39 ) - - // Change the type of cursor when in the box. Just slightly different than the - // normal. The character is shown in high intensity. - - FT_MDEFCRS( 0, 32767, 32512 ) - IF FT_MDBLCLK( 2, 0, 0.8 ) - EXIT - ENDIF - ENDIF - - IF FT_MINREGION( 18, 11, 18, 39 ) - - // Change the type of cursor when in the box. Just slightly different than the - // normal. The character is shown in high intensity. - - FT_MDEFCRS( 0, 32767, 32512 ) - ELSE - - // Put the cursor back to normal mode - - FT_MDEFCRS( 0, 30719, 30464 ) - ENDIF - - FT_MMICKEYS( @nX, @nY ) - ENDDO - - FT_MHIDECRS() - - SetMode( nSaveRow, nSaveCol ) - SetColor( cSavClr ) - RestScreen( 0, 0, MaxRow(), MaxCol(), cSavScr ) - DevPos( MaxRow(), 0 ) - - // Reset sensitivity - - FT_MSETSENS( nHoriz, nVert, nDouble ) - - RETURN - -#endif - FUNCTION FT_MMICKEYS( nX, nY ) // read mouse motion counters /* aReg[ AX ] := 11 // set mouse function call 11 diff --git a/harbour/contrib/hbnf/mouse2.prg b/harbour/contrib/hbnf/mouse2.prg index da6bf37ff8..f2b9fcfc48 100644 --- a/harbour/contrib/hbnf/mouse2.prg +++ b/harbour/contrib/hbnf/mouse2.prg @@ -69,200 +69,6 @@ THREAD STATIC t_aReg[ 10 ] THREAD STATIC t_lCrsState := .F. THREAD STATIC t_lMinit := .F. -#ifdef FT_TEST - -// Pass valid row and column values for different video modes to change modes - -PROCEDURE Main( nRow, nCol ) - - LOCAL nX, nY, cSavClr - LOCAL cSavScr := SaveScreen( 0, 0, MaxRow(), MaxCol() ) - LOCAL nSaveRow := MaxRow() + 1, nSaveCol := MaxCol() + 1 - LOCAL nMinor, nType, nIRQ - LOCAL aType := { "Bus", "Serial", "InPort", "PS/2", "HP" } - LOCAL nHoriz, nVert, nDouble - - IF nRow == NIL - nRow := MaxRow() + 1 - ELSE - nRow := Val( nRow ) - ENDIF - - IF nCol == NIL - nCol := MaxCol() + 1 - ELSE - nCol := Val( nCol ) - ENDIF - - IF ! SetMode( nRow, nCol ) - @ MaxRow(), 0 SAY "Mode Change unsuccessful:" + Str( nRow, 2, 0 ) + " by"; - + Str( nCol, 3, 0 ) - RETURN - ENDIF - - IF Empty( FT_MINIT() ) - @ MaxRow(), 0 SAY "Mouse driver is not installed!" - SetMode( nSaveRow, nSaveCol ) - RETURN - ENDIF - - // ..... Set up the screen - cSavClr := SetColor( "w/n" ) - @ 0, 0, MaxRow(), MaxCol() BOX hb_UTF8ToStr( "░░░░░░░░░" ) - - SetColor( "GR+/RB" ) - Scroll( 7, 2, 19, 63, 0 ) - @ 7, 2 TO 20, 63 - - @ 17, 10 TO 19, 40 double - - SetColor( "N/W" ) - @ 18, 11 SAY " Double Click here to Quit " - - SetColor( "GR+/RB" ) - - // ..... Start the demo - - @ MaxRow(), 0 SAY "Driver version: " + ; - AllTrim( Str( FT_MVERSION( @nMinor, @nType, @nIRQ ), 2, 0 ) ) + "." + ; - AllTrim( Str( nMinor, 2, 0 ) ) - @ Row(), Col() SAY " " + aType[ nType ] + " mouse using IRQ " + Str( nIRQ, 1, 0 ) - - FT_MGETSENS( @nHoriz, @nVert, @nDouble ) // Get the current sensitivities - FT_MSETSENS( 70, 70, 60 ) // Bump up the sensitivity of the mouse - - FT_MSHOWCRS() - FT_MSETCOORD( 10, 20 ) // just an arbitrary place for demo - - // put the unchanging stuff - - DevPos( 9, 10 ) - DevOut( "FT_MMICKEYS :" ) - - DevPos( 10, 10 ) - DevOut( "FT_MGETPOS :" ) - - DevPos( 11, 10 ) - DevOut( "FT_MGETX :" ) - - DevPos( 12, 10 ) - DevOut( "FT_MGETY :" ) - - DevPos( 13, 10 ) - DevOut( "FT_MGETCOORD:" ) - - DevPos( 14, 10 ) - DevOut( "FT_MBUTPRS :" ) - - DevPos( 16, 10 ) - DevOut( "FT_MBUTREL :" ) - - nX := nY := 1 - DO WHILE .T. - - // If we are not moving then wait for movement. - // This whole demo is a bit artificial in its requirements when compared - // to a "normal" CLIPPER program so some of these examples are a bit out of - // the ordinary. - - DO WHILE nX == 0 .AND. nY == 0 - FT_MMICKEYS( @nX, @nY ) - ENDDO - // tell the mouse driver where updates will be taking place so it can hide - // the cursor when necessary. - - FT_MCONOFF( 9, 23, 16, 53 ) - - DevPos( 9, 23 ) - DevOut( nX ) - DevOut( nY ) - - DevPos( 10, 23 ) - DevOut( FT_MGETPOS( @nX, @nY ) ) - DevOut( nX ) - DevOut( nY ) - - DevPos( 11, 23 ) - DevOut( FT_MGETX() ) - - DevPos( 12, 23 ) - DevOut( FT_MGETY() ) - - DevPos( 13, 23 ) - DevOut( FT_MGETCOORD( @nX, @nY ) ) - DevOut( nX ) - DevOut( nY ) - - nX := nY := 0 - DevPos( 14, 23 ) - DevOut( FT_MBUTPRS( 1 ) ) - DevOut( FT_MBUTPRS( 0,, nX, nY ) ) - DevPos( 15, 23 ) - - // show only the last Press since it flashes by so quickly - - IF nX != 0 .OR. nY != 0 - DevOut( nX ) - DevOut( nY ) - ENDIF - - nX := nY := 0 - DevPos( 16, 23 ) - DevOut( FT_MBUTREL( 0,, @nX, @nY ) ) - - // show only the last release since it flashes by so quickly - - IF nX != 0 .OR. nY != 0 - DevOut( nX ) - DevOut( nY ) - ENDIF - - // Restore the cursor if it has been hidden - - FT_MSHOWCRS() - - IF FT_MINREGION( 18, 11, 18, 39 ) - - // Change the type of cursor when in the box. Just slightly different than the - // normal. The character is shown in high intensity. - - FT_MDEFCRS( 0, 32767, 32512 ) - IF FT_MDBLCLK( 2, 0, 0.8 ) - EXIT - ENDIF - ENDIF - - IF FT_MINREGION( 18, 11, 18, 39 ) - - // Change the type of cursor when in the box. Just slightly different than the - // normal. The character is shown in high intensity. - - FT_MDEFCRS( 0, 32767, 32512 ) - ELSE - - // Put the cursor back to normal mode - - FT_MDEFCRS( 0, 30719, 30464 ) - ENDIF - - FT_MMICKEYS( @nX, @nY ) - ENDDO - - FT_MHIDECRS() - - SetMode( nSaveRow, nSaveCol ) - SetColor( cSavClr ) - RestScreen( 0, 0, MaxRow(), MaxCol(), cSavScr ) - DevPos( MaxRow(), 0 ) - - // Reset sensitivity - - FT_MSETSENS( nHoriz, nVert, nDouble ) - - RETURN - -#endif - FUNCTION FT_MINIT() // If not previously initialized then try diff --git a/harbour/contrib/hbnf/netpv.prg b/harbour/contrib/hbnf/netpv.prg index ec87cd6697..3b6045953d 100644 --- a/harbour/contrib/hbnf/netpv.prg +++ b/harbour/contrib/hbnf/netpv.prg @@ -23,16 +23,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main() - - ? FT_NETPV( 10000, 10, { 10000, 15000, 16000, 17000 } ) - - RETURN - -#endif - FUNCTION FT_NETPV( nInitialInvestment, nInterestRate, aCashFlow, nNoOfCashFlows ) LOCAL nNetPresentValue := 0 diff --git a/harbour/contrib/hbnf/ntow.prg b/harbour/contrib/hbnf/ntow.prg index 702201e4ad..68a9f7eb5f 100644 --- a/harbour/contrib/hbnf/ntow.prg +++ b/harbour/contrib/hbnf/ntow.prg @@ -35,16 +35,6 @@ STATIC sc_tens := { "", "", " Twenty", " Thirty", " Forty", " Fifty", ; STATIC sc_qualifiers := { "", " Thousand", " Million", " Billion", " Trillion" } -#ifdef FT_TEST - -PROCEDURE Main( cNum ) - - QOut( ft_ntow( Val( cNum ) ) ) - - RETURN - -#endif - FUNCTION ft_ntow( nAmount ) LOCAL nTemp, sResult := " ", nQualNo diff --git a/harbour/contrib/hbnf/nwlstat.prg b/harbour/contrib/hbnf/nwlstat.prg index 0e31b4409a..8a755cf818 100644 --- a/harbour/contrib/hbnf/nwlstat.prg +++ b/harbour/contrib/hbnf/nwlstat.prg @@ -29,16 +29,6 @@ #define DOS 33 #define STATNUM 220 -#ifdef FT_TEST - -PROCEDURE Main() - - QOut( "Logical station: " + Str( FT_NWLSTAT() ) ) - - RETURN - -#endif - FUNCTION FT_NWLSTAT() // LOCAL aRegs[ INT86_MAX_REGS ] diff --git a/harbour/contrib/hbnf/nwsem.prg b/harbour/contrib/hbnf/nwsem.prg index 9a0d4fab0b..a49736a216 100644 --- a/harbour/contrib/hbnf/nwsem.prg +++ b/harbour/contrib/hbnf/nwsem.prg @@ -48,56 +48,6 @@ // Sorry this test routine is pretty lame but it sort of gets // the point across -#ifdef FT_TEST - -#define INITIAL_SEMAPHORE_VALUE 2 -#define WAIT_SECONDS 1 - -PROCEDURE Main() - - LOCAL nInitVal, nRc, nHandle, nValue, nOpenCnt - - CLS - - nInitVal := INITIAL_SEMAPHORE_VALUE - FT_NWSEMOPEN( "TEST", nInitVal, @nHandle, @nOpenCnt ) - - QOut( "Waiting ten seconds..." ) - nRc := ft_nwSemWait( nHandle, 180 ) - QOut( "Final nRc value = " + Str( nRc ) ) - Inkey( 0 ) - IF nRc == 254 - QOut( "Couldn't get the semaphore. Try again." ) - QUIT - ENDIF - - CLS - - @ 24, 0 SAY "Any key to exit" - @ 0, 0 SAY "Handle: " + Str( nHandle ) - - ft_nwSemEx( nHandle, @nValue, @nOpenCnt ) - WHILE .T. - @ 23, 0 SAY "Semaphore test -> Open at [" + ; - hb_ntos( nOpenCnt ) + ; - "] stations, value is [" + ; - hb_ntos( nValue ) + "]" - - IF Inkey( WAIT_SECONDS ) != 0 - EXIT - ENDIF - - Tone( nHandle, .5 ) - ft_nwSemEx( nHandle, @nValue, @nOpenCnt ) - ENDDO - - QOut( "Signal returns: " + Str( ft_nwsemSig( nHandle ) ) ) - QOut( "Close returns: " + Str( ft_nwsemClose( nHandle ) ) ) - - RETURN - -#endif - FUNCTION ft_nwSemOpen( cName, nInitVal, nHandle, nOpenCnt ) LOCAL aRegs[ INT86_MAX_REGS ], cRequest, nRet diff --git a/harbour/contrib/hbnf/nwuid.prg b/harbour/contrib/hbnf/nwuid.prg index 47d4e73c5a..e64f2120ff 100644 --- a/harbour/contrib/hbnf/nwuid.prg +++ b/harbour/contrib/hbnf/nwuid.prg @@ -36,26 +36,6 @@ #define DOS 33 #define NW_LOG 227 -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL x, cUid - - QOut( "I am: [" + FT_NWUID() + "]" ) - QOut( "---------------------" ) - - FOR x := 1 TO 100 - cUid := FT_NWUID( x ) - IF ! Empty( cUid ) - QOut( Str( x, 3 ) + Space( 3 ) + cUid ) - ENDIF - NEXT - - RETURN - -#endif - FUNCTION FT_NWUID( nConn ) LOCAL aRegs[ INT86_MAX_REGS ] diff --git a/harbour/contrib/hbnf/pending.prg b/harbour/contrib/hbnf/pending.prg index 9971eb8b64..f4bc6b19ba 100644 --- a/harbour/contrib/hbnf/pending.prg +++ b/harbour/contrib/hbnf/pending.prg @@ -20,22 +20,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main() - - @ 0, 0 CLEAR - FT_PENDING( "Message one", 20, 0, 3, "W+/G" ) // Displays "Message one." - // sets row to 20, col to 0. - // wait to 3 and color to - // bright white over green. - FT_PENDING( "Message two" ) // Displays "Message two", after 5 sec. - FT_PENDING( "Message three" ) // Displays "Message three", after 5 sec. - - RETURN - -#endif - FUNCTION FT_PENDING( cMsg, nRow, nCol, nWait, cColor ) THREAD STATIC t_nLast_Time := 0 diff --git a/harbour/contrib/hbnf/pickday.prg b/harbour/contrib/hbnf/pickday.prg index aa1f532f64..ee035666ae 100644 --- a/harbour/contrib/hbnf/pickday.prg +++ b/harbour/contrib/hbnf/pickday.prg @@ -24,16 +24,6 @@ */ // test code -#ifdef FT_TEST - -PROCEDURE Main() - - QOut( "You selected " + FT_PICKDAY() ) - - RETURN - -#endif - FUNCTION FT_PICKDAY() LOCAL days := { "SUNDAY", "MONDAY", "TUESDAY", "WEDNESDAY", "THURSDAY", ; diff --git a/harbour/contrib/hbnf/popadder.prg b/harbour/contrib/hbnf/popadder.prg index 696f207ac1..bf8b8833f4 100644 --- a/harbour/contrib/hbnf/popadder.prg +++ b/harbour/contrib/hbnf/popadder.prg @@ -114,50 +114,6 @@ THREAD STATIC t_nWinColor THREAD STATIC t_aWinColor THREAD STATIC t_aStdColor -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL nSickHrs := 0 - LOCAL nPersHrs := 0 - LOCAL nVacaHrs := 0 - LOCAL GetList := {} - - SET SCOREBOARD OFF - _ftSetScrColor( STD_SCREEN, STD_VARIABLE ) - CLS - - SET KEY K_ALT_A TO FT_Adder // Make call FT_Adder - - // SIMPLE Sample of program data entry! - - @ 12, 5 SAY "Please enter the total Sick, Personal, and Vacation hours." - @ 15, 22 SAY "Sick hrs." - @ 15, 40 SAY "Pers. hrs." - @ 15, 60 SAY "Vaca. hrs." - @ 23, 20 SAY "Press to Pop - Up the Adder." - @ 24, 20 SAY "Press to Quit the adder Demo." - DO WHILE .T. // Get the sick, personal, & vaca - @ 16, 24 GET nSickHrs PICTURE "9999.999" // Normally I have a VALID() - @ 16, 43 GET nPersHrs PICTURE "9999.999" // to make sure the value is - @ 16, 63 GET nVacaHrs PICTURE "9999.999" // within the allowable range. - SET CURSOR ON // But, like I said it is a - CLEAR TYPEAHEAD // SIMPLE example . - READ - SET CURSOR OFF - IF LastKey() == K_ESC // - ABORT - CLEAR TYPEAHEAD - EXIT - ENDIF - ENDDO - SET CURSOR ON - - SET KEY K_ALT_A // Reset - - RETURN - -#endif - /*+- Function ---------------------------------------------------------------+ | Name: FT_Adder() Docs: Keith A. Wire | | Description: Pop Up Adder / Calculator with Tape Display | diff --git a/harbour/contrib/hbnf/prtesc.prg b/harbour/contrib/hbnf/prtesc.prg index 9cc6acc5af..e9902e0122 100644 --- a/harbour/contrib/hbnf/prtesc.prg +++ b/harbour/contrib/hbnf/prtesc.prg @@ -23,26 +23,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main( cParm1 ) - - //------------------------------------------------------- - // Sample routine to test function from command line - //------------------------------------------------------- - - IF PCount() > 0 - ? FT_ESCCODE( cParm1 ) - ELSE - ? "Usage: PRT_ESC 'escape code sequence' " - ? " outputs converted code to standard output" - ? - ENDIF - - RETURN - -#endif - FUNCTION FT_ESCCODE( cInput ) LOCAL cOutput := "" diff --git a/harbour/contrib/hbnf/rand1.prg b/harbour/contrib/hbnf/rand1.prg index f9adef3062..3aa0530510 100644 --- a/harbour/contrib/hbnf/rand1.prg +++ b/harbour/contrib/hbnf/rand1.prg @@ -23,25 +23,6 @@ * */ -#ifdef FT_TEST - -// Write 100 random numbers from 1 to 100 to stdout. -// Run it multiple times and redirect output to a file -// to check it - -PROCEDURE Main() - - LOCAL x - - FOR x := 1 TO 100 - OutStd( Int( ft_rand1(100 ) ) ) - OutStd( hb_eol() ) - NEXT - - RETURN - -#endif - FUNCTION ft_rand1( nMax ) THREAD STATIC t_nSeed diff --git a/harbour/contrib/hbnf/savearr.prg b/harbour/contrib/hbnf/savearr.prg index 36e69c9cdd..25918b5b57 100644 --- a/harbour/contrib/hbnf/savearr.prg +++ b/harbour/contrib/hbnf/savearr.prg @@ -32,50 +32,6 @@ MEMVAR lRet -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL aArray := {; - { "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 ) - IF nErrorCode == 0 - CLS - DispArray( aArray ) - aSave := FT_RESTARR( "invoice.dat", @nErrorCode ) - IF nErrorCode == 0 - DispArray( aSave ) - ELSE - ? "Error restoring array" - ENDIF - ELSE - ? "Error writing array" - ENDIF - - RETURN - -FUNCTION DispArray( aTest ) - - LOCAL nk - - FOR nk := 1 TO Len( aTest ) - ? aTest[ nk, 1 ] - ?? " " - ?? DToC( aTest[ nk, 2 ] ) - ?? " " - ?? Str( aTest[ nk, 3 ] ) - ?? " " - ?? iif( aTest[ nk, 4 ], "true", "false" ) - NEXT - - RETURN NIL - -#endif - FUNCTION FT_SAVEARR( aArray, cFileName, nErrorCode ) LOCAL nHandle, lRet diff --git a/harbour/contrib/hbnf/savesets.prg b/harbour/contrib/hbnf/savesets.prg index ca432156fa..03e72554d0 100644 --- a/harbour/contrib/hbnf/savesets.prg +++ b/harbour/contrib/hbnf/savesets.prg @@ -32,20 +32,6 @@ #define FT_SET_CENTURY _SET_COUNT + 1 #define FT_SET_BLINK _SET_COUNT + 2 -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL aSets := FT_SAVESETS() - - HB_SYMBOL_UNUSED( aSets ) - - Inkey( 0 ) - - RETURN - -#endif - FUNCTION FT_SAVESETS() LOCAL aOldSets := Array( _SET_COUNT + FT_EXTRA_SETS ) diff --git a/harbour/contrib/hbnf/scancode.prg b/harbour/contrib/hbnf/scancode.prg index c01a501446..ab918e94c4 100644 --- a/harbour/contrib/hbnf/scancode.prg +++ b/harbour/contrib/hbnf/scancode.prg @@ -28,29 +28,6 @@ #include "ftint86.ch" -#ifdef FT_TEST - -#define SCANCODE_ESCAPE ( hb_BChar( 27 ) + hb_BChar( 1 ) ) - -PROCEDURE Main() - - LOCAL cKey - - CLS - QOut( "Press any key, ESCape to exit:" ) - - DO WHILE .T. - cKey := FT_SCANCODE() - QOut( Str( hb_BCode( hb_BSubStr( cKey, 1, 1 ) ), 3 ) + ", " + Str( hb_BCode( hb_BSubStr( cKey, 2, 1 ) ), 3 ) + hb_eol() ) - IF cKey == SCANCODE_ESCAPE - EXIT - ENDIF - ENDDO - - RETURN - -#endif - #define KEYB 22 FUNCTION FT_SCANCODE() diff --git a/harbour/contrib/hbnf/setdate.prg b/harbour/contrib/hbnf/setdate.prg index 1cc9483d01..f47e9dd2c9 100644 --- a/harbour/contrib/hbnf/setdate.prg +++ b/harbour/contrib/hbnf/setdate.prg @@ -32,19 +32,6 @@ #define DOS 33 #define SETDATE 43 -#ifdef FT_TEST - -PROCEDURE Main( cDate ) - - cDate := iif( cDate == NIL, DToC( Date() ), cDate ) - QOut( "Setting date to: " + cDate + "... " ) - FT_SETDATE( CToD( cDate ) ) - QOut( "Today is now: " + DToC( Date() ) ) - - RETURN - -#endif - FUNCTION FT_SETDATE( dDate ) LOCAL aRegs[ INT86_MAX_REGS ] diff --git a/harbour/contrib/hbnf/settime.prg b/harbour/contrib/hbnf/settime.prg index b99896bfd5..65ffe6ed8c 100644 --- a/harbour/contrib/hbnf/settime.prg +++ b/harbour/contrib/hbnf/settime.prg @@ -32,22 +32,9 @@ #define DOS 33 #define SETTIME 45 -#define SECS( ts ) ( val( substr( ts, 7 ) ) ) -#define HRS( ts ) ( val( substr( ts, 1, 2 ) ) ) -#define MINS( ts ) ( val( substr( ts, 4, 2 ) ) ) - -#ifdef FT_TEST - -PROCEDURE Main( cTime ) - - cTime := iif( cTime == NIL, Time(), cTime ) - QOut( "Setting time to: " + cTime + "... " ) - FT_SETTIME( cTime ) - QOut( "Time is now: " + Time() ) - - RETURN - -#endif +#define SECS( ts ) ( Val( SubStr( ts, 7 ) ) ) +#define HRS( ts ) ( Val( SubStr( ts, 1, 2 ) ) ) +#define MINS( ts ) ( Val( SubStr( ts, 4, 2 ) ) ) FUNCTION FT_SETTIME( cTime ) diff --git a/harbour/contrib/hbnf/sleep.prg b/harbour/contrib/hbnf/sleep.prg index 26adbb6709..ec0b27ae94 100644 --- a/harbour/contrib/hbnf/sleep.prg +++ b/harbour/contrib/hbnf/sleep.prg @@ -20,21 +20,6 @@ * */ -#ifdef FT_TEST - -// Test routine -// Invoke by running SLEEP 1.0 to sleep 1.0 seconds - -PROCEDURE Main( nSleep ) - - ? "Time is now: " + Time() - FT_SLEEP( Val( nSleep ) ) - ? "Time is now: " + Time() - - RETURN - -#endif - FUNCTION FT_SLEEP( nSeconds, nInitial ) IF ! HB_ISNUMERIC( nInitial ) diff --git a/harbour/contrib/hbnf/sysmem.prg b/harbour/contrib/hbnf/sysmem.prg index e9ba7991fb..f6b6097d9d 100644 --- a/harbour/contrib/hbnf/sysmem.prg +++ b/harbour/contrib/hbnf/sysmem.prg @@ -33,16 +33,6 @@ #define MEMSIZE 18 -#ifdef FT_TEST - -PROCEDURE Main() - - QOut( "Conventional memory: " + Str( FT_SYSMEM() ) + "K installed" ) - - RETURN - -#endif - FUNCTION FT_SYSMEM() LOCAL aRegs[ INT86_MAX_REGS ] diff --git a/harbour/contrib/hbnf/tbwhile.prg b/harbour/contrib/hbnf/tbwhile.prg index f121e75d78..9290eacf27 100644 --- a/harbour/contrib/hbnf/tbwhile.prg +++ b/harbour/contrib/hbnf/tbwhile.prg @@ -59,113 +59,6 @@ #include "set.ch" #include "setcurs.ch" -#ifdef FT_TEST - -/* - * THIS DEMO SHOWS tbnames.dbf CONSISTING OF LAST, FIRST, ADDR, CITY, - * STATE, ZIP WITH ACTIVE INDEX ON LAST + FIRST. IT SHOWS LAST NAME, - * FIRST NAME, CITY ONLY FOR THOSE LAST NAMES THAT BEGIN WITH LETTER - * THAT YOU INPUT FOR THE CKEY GET. - * - * tbnames.dbf/.ntx ARE AUTOMATICALLY CREATED BY THIS TEST PROGRAM - */ - -PROCEDURE Main() - - LOCAL aFields := {}, cKey := "O", cOldColor - LOCAL nFreeze := 1, lSaveScrn := .T. , nRecSel - LOCAL cColorList := "N/W, N/BG, B/W, B/BG, B/W, B/BG, R/W, B/R" - LOCAL cColorShad := "N/N" - FIELD last, first - MEMVAR GetList - - IF ! hb_FileExists( "tbnames.dbf" ) - MAKE_DBF() - ENDIF - - USE TBNames - - IF ! hb_FileExists( "tbnames.ntx" ) - INDEX ON last + first TO TBNAMES - ENDIF - - SET INDEX TO TBNAMES - - // Pass Heading as character and Field as Block including Alias - // To eliminate the need to use FIELDWBLOCK() function in FT_BRWSWHL() - - AAdd( aFields, { "Last Name" , {|| TBNames->Last } } ) - AAdd( aFields, { "First Name", {|| TBNames->First } } ) - AAdd( aFields, { "City" , {|| TBNames->City } } ) - - cOldColor := SetColor( "N/BG" ) - CLS - @ 5, 10 SAY "Enter First Letter Of Last Name:" GET cKey PICTURE "!" - READ - - // TBNames->Last = cKey is the Conditional Block passed to this function - // you can make it as complicated as you want, but you would then - // have to modify TBWhileSet() to find first and last records - // matching your key. - nRecSel := FT_BRWSWHL( aFields, {|| TBNames->Last = cKey }, cKey, nFreeze, ; - lSaveScrn, cColorList, cColorShad, 3, 6, MaxRow() - 2, MaxCol() - 6 ) - // Note you can use Compound Condition - // such as cLast =: "Pierce " and cFirst =: "Hawkeye " - // by changing above block to: - // {|| TBNames->Last = cLast .AND. TBNames->First = cFirst } - // and setting cKey := cLast + cFirst - - ? - IF nRecSel == 0 - ? "Sorry, NO Records Were Selected" - ELSE - ? "You Selected " + TBNames->Last + " " + ; - TBNames->First + " " + TBNames->City - ENDIF - ? - - WAIT - SetColor( cOldColor ) - CLS - - RETURN - -STATIC FUNCTION make_dbf() - - LOCAL x, aData := { ; - { "SHAEFER", "KATHRYN", "415 WEST CITRUS ROAD #150", "LOS ANGELES", "CA", "90030" }, ; - { "OLSON", "JAMES", "225 NORTH RANCH ROAD", "LOS ANGELES", "CA", "90023" }, ; - { "KAYBEE", "JOHN", "123 SANDS ROAD", "CAMARILLO", "CA", "93010" }, ; - { "HERMAN", "JIM", "123 TOON PAGE ROAD", "VENTURA", "CA", "93001" }, ; - { "BURNS", "FRANK", "123 VIRGINA STREET", "OXNARD", "CA", "93030" }, ; - { "PIERCE", "HAWKEYE", "123 OLD TOWN ROAD", "PORT MUGU", "CA", "93043" }, ; - { "MORGAN", "JESSICA", "123 FRONTAGE ROAD", "CAMARILLO", "CA", "93010" }, ; - { "POTTER", "ROBERT", "123 FIR STREET", "OXNARD", "CA", "93030" }, ; - { "WORTH", "MARY", "123-1/2 JOHNSON DRIVE", "OXNARD", "CA", "93033" }, ; - { "JOHNSON", "SUSAN", "123 QUEENS STREET", "OXNARD", "CA", "93030" }, ; - { "SAMSON", "SAM", "215 MAIN STREET", "OXNARD", "CA", "93030" }, ; - { "NEWNAME", "JAMES", "215 MAIN STREET", "LOS ANGELES", "CA", "90000" }, ; - { "OLEANDAR", "JILL", "425 FLORAL PARK DRIVE", "FLORAL PARK", "NY", "10093" }, ; - { "SUGARMAN", "CANDY", "1541 SWEETHEART ROAD", "HERSHEY", "PA", "10132" } } - - dbCreate( "TBNAMES", {; - { "LAST ", "C", 18, 0, } , ; - { "FIRST", "C", 9, 0, } , ; - { "ADDR ", "C", 28, 0, } , ; - { "CITY ", "C", 21, 0, } , ; - { "STATE", "C", 2, 0, } , ; - { "ZIP ", "C", 9, 0, } } ) - USE tbnames - FOR x := 1 TO Len( aData ) - APPEND BLANK - AEval( aData[ x ], {| e, n | FieldPut( n, e ) } ) - NEXT - USE - - RETURN NIL - -#endif - /* ------------------------------------------------------------------- */ FUNCTION FT_BRWSWHL( aFields, bWhileCond, cKey, nFreeze, lSaveScrn, ; diff --git a/harbour/contrib/hbnf/tempfile.prg b/harbour/contrib/hbnf/tempfile.prg index b3d0fcbc43..1043e00ba3 100644 --- a/harbour/contrib/hbnf/tempfile.prg +++ b/harbour/contrib/hbnf/tempfile.prg @@ -112,24 +112,3 @@ FUNCTION FT_TEMPFIL( cPath, lHide, nHandle ) RETURN cFile #endif /* FT_TEMPFILE_ORIGINAL */ - -#ifdef FT_TEST - -PROCEDURE Main( cPath, cHide ) - - LOCAL cFile, nHandle - - cFile := FT_TEMPFIL( cPath, ( cHide == "Y" ) ) - - IF ! Empty( cFile ) - QOut( cFile ) - nHandle := FOpen( cFile, FO_WRITE ) - FWrite( nHandle, "This is a test!" ) - FClose( nHandle ) - ELSE - QOut( "An error occurred" ) - ENDIF - - RETURN - -#endif diff --git a/harbour/contrib/hbnf/tests/aading.prg b/harbour/contrib/hbnf/tests/aading.prg new file mode 100644 index 0000000000..f50f5a290b --- /dev/null +++ b/harbour/contrib/hbnf/tests/aading.prg @@ -0,0 +1,42 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL aList1, aList2, var0, nstart, nstop, nelapsed, nCtr + + CLS + ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AADDITION" + ? + aList1 := { "apple", "orange", "pear" } + aList2 := { "apple ", "banana", "PEAR" } + ? "aList1 : " + AEval( aList1, {| x | QQOut( x + "," ) } ) + ? + ? "aList2 : " + AEval( aList2, {| x | QQOut( x + "," ) } ) + ? + + nstart := Seconds() + FOR nCtr := 1 TO 100 + var0 := FT_AADDITION( aList1, aList2 ) + NEXT + nstop := Seconds() + nelapsed := nstop - nstart + ? "time for 100 merges:", nelapsed + + ? PadR( "FT_AADDITION( aList1, aList2 ) ->", 44 ) + AEval( var0, {| x | QQOut( x + "," ) } ) + ? + var0 := FT_AADDITION( aList1, aList2, , .F. ) + ? PadR( "FT_AADDITION( aList1, aList2, , .F. ) ->", 44 ) + AEval( var0, {| x | QQOut( x + "," ) } ) + ? + var0 := FT_AADDITION( aList1, aList2, .F. , .F. ) + ? PadR( "FT_AADDITION( aList1, aList2, .F., .F. ) ->", 44 ) + AEval( var0, {| x | QQOut( x + "," ) } ) + ? + + RETURN + diff --git a/harbour/contrib/hbnf/tests/aemaxlen.prg b/harbour/contrib/hbnf/tests/aemaxlen.prg new file mode 100644 index 0000000000..f6f64a4cc9 --- /dev/null +++ b/harbour/contrib/hbnf/tests/aemaxlen.prg @@ -0,0 +1,32 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL var0, myarray1 := Directory() + + CLS + ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AEMAXLEN" + ? + ? "myarray1 := DIRECTORY()" + ? + var0 := FT_AEMAXLEN( myarray1 ) + ? PadR( "FT_AEMAXLEN( myarray1 ) ->", 30 ) + ?? var0 + ? + var0 := FT_AEMAXLEN( myarray1, 2 ) + ? PadR( "FT_AEMAXLEN( myarray1, 2 ) ->", 30 ) + ?? var0 + ? + var0 := FT_AEMAXLEN( myarray1, 3 ) + ? PadR( "FT_AEMAXLEN( myarray1, 3 ) ->", 30 ) + ?? var0 + ? + var0 := FT_AEMAXLEN( ATail( myarray1 ) ) + ? PadR( "FT_AEMAXLEN( aTail( myarray1 ) ) ->", 30 ) + ?? var0 + ? + + RETURN + diff --git a/harbour/contrib/hbnf/tests/aeminlen.prg b/harbour/contrib/hbnf/tests/aeminlen.prg new file mode 100644 index 0000000000..e80f3d0680 --- /dev/null +++ b/harbour/contrib/hbnf/tests/aeminlen.prg @@ -0,0 +1,35 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL var0, myarray1 := Directory() + + CLS + ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AEMINLEN" + ? + ? "myarray1 := DIRECTORY()" + ? + 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 + ? + var0 := FT_AEMINLEN( myarray1, 2 ) + ? PadR( "FT_AEMINLEN( myarray1, 2 ) ->", 30 ) + ?? var0 + ? + ? + var0 := FT_AEMINLEN( myarray1[ 2 ] ) + ? PadR( "FT_AEMINLEN( myarray1[ 2 ] ) ->", 30 ) + ?? var0 + ? + ? + var0 := FT_AEMINLEN( myarray1, 3 ) + ? PadR( "FT_AEMINLEN( myarray1, 3 ) ->", 30 ) + ?? var0 + ? + + RETURN + diff --git a/harbour/contrib/hbnf/tests/amedian.prg b/harbour/contrib/hbnf/tests/amedian.prg new file mode 100644 index 0000000000..7ae3dc8f35 --- /dev/null +++ b/harbour/contrib/hbnf/tests/amedian.prg @@ -0,0 +1,33 @@ +/* + * $Id$ + */ + +#include "directry.ch" + +PROCEDURE Main() + + LOCAL var0, myarray0 := Directory(), myarray1 := {} + + CLS + ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AMEDIAN" + ? + AEval( myarray0, {| x | AAdd( myarray1, x[ F_SIZE ] ) } ) + var0 := FT_AMEDIAN( myarray1 ) + ? PadR( "FT_AMEDIAN( myarray1 ) ->", 35 ) + ?? var0 + ? + var0 := FT_AMEDIAN( myarray1, 2 ) + ? PadR( "FT_AMEDIAN( myarray1, 2 ) ->", 35 ) + ?? var0 + ? + var0 := FT_AMEDIAN( myarray1, , 9 ) + ? PadR( "FT_AMEDIAN( myarray1, , 9 ) ->", 35 ) + ?? var0 + ? + var0 := FT_AMEDIAN( myarray1, 8, 40 ) + ? PadR( "FT_AMEDIAN( myarray1, 8, 40 ) ->", 35 ) + ?? var0 + ? + + RETURN + diff --git a/harbour/contrib/hbnf/tests/aredit.prg b/harbour/contrib/hbnf/tests/aredit.prg new file mode 100644 index 0000000000..53d17fc0ea --- /dev/null +++ b/harbour/contrib/hbnf/tests/aredit.prg @@ -0,0 +1,67 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + // Thanks to Jim Gale for helping me understand the basics + LOCAL i, ar[ 3, 26 ], aBlocks[ 3 ], aHeadings, nElem := 1, bGetFunc, cRet + // set up 2 dimensional array ar[] + FOR i := 1 TO 26 + ar[ 1, i ] := i // 1 -> 26 Numeric + ar[ 2, i ] := Chr( Asc( "A" ) + i - 1 ) // "A" -> "Z" Character + ar[ 3, i ] := Chr( Asc( "Z" ) - i + 1 ) // "Z" -> "A" Character + NEXT i + // Set Up aHeadings[] for column headings + aHeadings := { "Numbers", "Letters", "Reverse" } + // Set Up Blocks Describing Individual Elements in Array ar[] + aBlocks[ 1 ] := {|| Str( ar[ 1, nElem ], 2 ) } // to prevent default 10 spaces + aBlocks[ 2 ] := {|| ar[ 2, nElem ] } + aBlocks[ 3 ] := {|| ar[ 3, nElem ] } + // Set up TestGet() as bGetFunc + bGetFunc := {| b, ar, nDim, nElem | TestGet( b, ar, nDim, nElem ) } + + SET SCOREBOARD OFF + SetColor( "W/N" ) + CLS + @ 21, 4 SAY "Use Cursor Keys To Move Between Fields, = Delete Row, = Add Row" + @ 22, 7 SAY " = Quit Array Edit, or Edits Element" + SetColor( "N/W, W/N, , , W/N" ) + cRet := FT_ArEdit( 3, 5, 18, 75, ar, @nElem, aHeadings, aBlocks, bGetFunc ) + SetColor( "W/N" ) + CLS + ? cRet + ? "Lastkey() = ESC:", LastKey() == K_ESC + + RETURN + +FUNCTION TestGet( b, ar, nDim, nElem ) + + LOCAL GetList := {} + LOCAL nRow := Row() + LOCAL nCol := Col() + LOCAL cSaveScrn := SaveScreen( 21, 0, 22, MaxCol() ) + LOCAL cOldColor := SetColor( "W/N" ) + + @ 21, 0 CLEAR TO 22, MaxCol() + @ 21, 29 SAY "Editing Array Element" + SetColor( cOldColor ) + DO CASE + CASE nDim == 1 + @ nRow, nCol GET ar[ 1, nElem ] PICTURE "99" + READ + b:refreshAll() + CASE nDim == 2 + @ nRow, nCol GET ar[ 2, nElem ] PICTURE "!" + READ + b:refreshAll() + CASE nDim == 3 + @ nRow, nCol GET ar[ 3, nElem ] PICTURE "!" + READ + b:refreshAll() + ENDCASE + RestScreen( 21, 0, 22, MaxCol(), cSaveScrn ) + @ nRow, nCol SAY "" + + RETURN .T. + diff --git a/harbour/contrib/hbnf/tests/at2.prg b/harbour/contrib/hbnf/tests/at2.prg new file mode 100644 index 0000000000..4ec323c771 --- /dev/null +++ b/harbour/contrib/hbnf/tests/at2.prg @@ -0,0 +1,31 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL cSearch, cTarget, var0 + + CLS + ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AT2" + ? + cSearch := "t" + ? "Find occurrences of 't' in: " + cTarget := "This is the day that the Lord has made." + ?? cTarget + ? + var0 := ft_at2( cSearch, cTarget ) + ? PadR( "FT_AT2( cSearch, cTarget ) -> ", 40 ) + ?? var0 + ? + var0 := ft_at2( cSearch, cTarget, 2 ) + ? PadR( "FT_AT2( cSearch, cTarget, 2 ) -> ", 40 ) + ??var0 + ? + var0 := ft_at2( cSearch, cTarget, 2, .F. ) + ? PadR( "FT_AT2( cSearch, cTarget, 2, .F. ) -> ", 40 ) + ??var0 + ? + + RETURN + diff --git a/harbour/contrib/hbnf/tests/blink.prg b/harbour/contrib/hbnf/tests/blink.prg new file mode 100644 index 0000000000..9de998949d --- /dev/null +++ b/harbour/contrib/hbnf/tests/blink.prg @@ -0,0 +1,10 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + FT_BLINK( "WAIT", 5, 10 ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/calendar.prg b/harbour/contrib/hbnf/tests/calendar.prg new file mode 100644 index 0000000000..9dfe38f536 --- /dev/null +++ b/harbour/contrib/hbnf/tests/calendar.prg @@ -0,0 +1,26 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL aRet + + SetColor( "w+/b" ) + CLS + IF ft_numlock() + ft_numlock( .F. ) + ENDIF + hb_keyPut( K_F1 ) + 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 + diff --git a/harbour/contrib/hbnf/tests/clrsel.prg b/harbour/contrib/hbnf/tests/clrsel.prg new file mode 100644 index 0000000000..e2f326e85e --- /dev/null +++ b/harbour/contrib/hbnf/tests/clrsel.prg @@ -0,0 +1,53 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cVidMode ) + + LOCAL nRowDos := Row() + LOCAL nColDos := Col() + LOCAL aEnvDos := FT_SaveSets() + LOCAL cScrDos := SaveScreen( 0, 0, MaxRow(), MaxCol() ) + LOCAL lColour + LOCAL aClrs + + DEFAULT cVidMode TO "" + NoSnow( ( "NOSNOW" $ Upper( cVidMode ) ) ) + IF "VGA" $ Upper( cVidMode ) + SetMode( 50, 80 ) + ENDIF + IF "EGA" $ Upper( cVidMode ) + SetMode( 43, 80 ) + ENDIF + lColour := iif( "MONO" $ Upper( cVidMode ), .F. , IsColor() ) + + SET SCOREBOARD OFF + SetCursor( SC_NONE ) + SetBlink( .F. ) + + //.... a typical application might have the following different settings + // normally these would be stored in a .dbf/.dbv + aClrs := { ; + { "Desktop", "N/BG", "D", hb_UTF8ToStr( "▒" ) }, ; + { "Title", "N/W", "T" }, ; + { "Top Menu", "N/BG,N/W,W+/BG,W+/N,GR+/N", "M" }, ; + { "Sub Menu", "W+/N*,GR+/N*,GR+/N*,W+/R,G+/R", "M" }, ; + { "Standard Gets", "W/B, W+/N,,, W/N", "G" }, ; + { "Nested Gets", "N/BG, W+/N,,, W/N", "G" }, ; + { "Help", "N/G, W+/N,,, W/N", "W" }, ; + { "Error Messages", "W+/R*,N/GR*,,,N/R*", "W" }, ; + { "Database Query", "N/BG, N/GR*,,,N+/BG", "B" }, ; + { "Pick List", "N/GR*,W+/B,,, BG/GR*", "A" } } + + aClrs := FT_ClrSel( aClrs, lColour ) + + HB_SYMBOL_UNUSED( aClrs ) + + //.... restore the DOS environment + FT_RestSets( aEnvDos ) + RestScreen( 0, 0, MaxRow(), MaxCol(), cScrDos ) + SetPos( nRowDos, nColDos ) + SetBlink( .F. ) // doesn't appear to be reset from FT_RestSets + + RETURN + diff --git a/harbour/contrib/hbnf/tests/d2e.prg b/harbour/contrib/hbnf/tests/d2e.prg new file mode 100644 index 0000000000..0da06d48e4 --- /dev/null +++ b/harbour/contrib/hbnf/tests/d2e.prg @@ -0,0 +1,11 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cNum, cPrec ) + + DEFAULT cPrec TO Str( DEFAULT_PRECISION ) + QOut( ft_d2e( Val( cNum ), Val( cPrec ) ) ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/datecnfg.prg b/harbour/contrib/hbnf/tests/datecnfg.prg new file mode 100644 index 0000000000..dffaacd355 --- /dev/null +++ b/harbour/contrib/hbnf/tests/datecnfg.prg @@ -0,0 +1,204 @@ +/* + * $Id$ + */ + +//******************************************************************* +// +// NOTES: 1) The date functions are 'international'; i.e., the +// system date format is maintained, although ANSI is +// temporarily used within certain functions. +// +// 2) The date functions fall into two categories: +// +// a) Calendar or fiscal periods. +// A calendar or fiscal year is identified by the year() +// of the last date in the year. +// +// b) Accounting Periods. An accounting period has the +// following characteristics: +// If the first week of the period contains 4 or +// more 'work' days, it is included in the period; +// otherwise, the first week was included in the +// prior period. +// +// If the last week of the period contains 4 or more +// 'work' days it is included in the period; otherwise, +// the last week is included in the next period. +// This results in 13 week 'quarters' and 4 or 5 week +// 'months'. Every 5 or 6 years, a 'quarter' will contain +// 14 weeks and the year will contain 53 weeks. +// +// 3) The date functions require the presence of two variables: +// +// a) cFY_Start is a character string used to define the +// first day of a calendar or fiscal year. It's format +// is ANSI; e.g., "1980.01.01" defines a calendar year, +// "1980.10.01" defines a fiscal year, starting October 1. +// +// The year may be any valid year. It's value has no +// effect on the date functions. The day is assumed to be +// less than 29. See function: FT_DATECNFG(). +// +// B) nDow_Start is a number from 1 to 7 which defines the +// starting day, DOW(), of a work week; e.g., 1 == Sunday. +// +// See function: FT_DATECNFG() +// +// COMPILE ALL PROGRAMS WITH /N /W /A +// +//******************************************************************* + +PROCEDURE Main() + + 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. + dDate := Date() +// dDate := SToD( "19880229" ) // Test date, in user's normal date format + + CLS + ? "Given Date: " + ?? dDate + ?? " cFY_Start: " + cFY_Start + ?? " nDOW_Start:" + Str( nDOW_Start, 2 ) + ? "---- Fiscal Year Data -----------" + + aTestData := FT_YEAR( dDate ) + ? "FYYear ", aTestData[ 1 ] + " ", aTestData[ 2 ], aTestData[ 3 ] + + aTestData := FT_QTR( dDate ) + ? "FYQtr ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] + + nNum := Val( SubStr( aTestData[ 1 ], 5, 2 ) ) + aTestData := FT_QTR( dDate, nNum ) + ? "FYQtr " + Str( nNum, 2 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] + + aTestData := FT_MONTH( dDate ) + ? "FYMonth ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] + + nNum := Val( SubStr( aTestData[ 1 ], 5, 2 ) ) + aTestData := FT_MONTH( dDate, nNum ) + ? "FYMonth " + Str( nNum, 2 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] + + aTestData := FT_WEEK( dDate ) + ? "FYWeek ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] + + nNum := Val( SubStr( aTestData[ 1 ], 5, 2 ) ) + aTestData := FT_WEEK( dDate, nNum ) + ? "FYWeek " + Str( nNum, 2 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] + + aTestData := FT_DAYOFYR( dDate ) + ? "FYDay ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] + + nNum := Val( SubStr( aTestData[ 1 ], 5, 3 ) ) + aTestData := FT_DAYOFYR( dDate, nNum ) + ? "FYDAY " + Str( nNum, 3 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] + + ? + ? "---- Accounting Year Data -------" + + aTestData := FT_ACCTYEAR( dDate ) + ? "ACCTYear ", aTestData[ 1 ] + " ", aTestData[ 2 ], aTestData[ 3 ], ; + Str( ( aTestData[ 3 ] - aTestData[ 2 ] + 1 ) / 7, 3 ) + " Weeks" + + aTestData := FT_ACCTQTR( dDate ) + ? "ACCTQtr ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ], ; + Str( ( aTestData[ 3 ] - aTestData[ 2 ] + 1 ) / 7, 3 ) + " Weeks" + + nNum := Val( SubStr( aTestData[ 1 ], 5, 2 ) ) + aTestData := FT_ACCTQTR( dDate, nNum ) + ? "ACCTQtr " + Str( nNum, 2 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] + + aTestData := FT_ACCTMONTH( dDate ) + ? "ACCTMonth ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ], ; + Str( ( aTestData[ 3 ] - aTestData[ 2 ] + 1 ) / 7, 3 ) + " Weeks" + + nNum := Val( SubStr( aTestData[ 1 ], 5, 2 ) ) + aTestData := FT_ACCTMONTH( dDate, nNum ) + ? "ACCTMonth" + Str( nNum, 2 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] + + aTestData := FT_ACCTWEEK( dDate ) + ? "ACCTWeek ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] + + nNum := Val( SubStr( aTestData[ 1 ], 5, 2 ) ) + aTestData := FT_ACCTWEEK( dDate, nNum ) + ? "ACCTWeek " + Str( nNum, 2 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] + + aTestData := FT_DAYOFYR( dDate, , .T. ) + ? "ACCTDay ", aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] + + nNum := Val( SubStr( aTestData[ 1 ], 5, 3 ) ) + aTestData := FT_DAYOFYR( dDate, nNum, .T. ) + ? "ACCTDay " + Str( nNum, 3 ), aTestData[ 1 ], aTestData[ 2 ], aTestData[ 3 ] + + WAIT + + FT_CAL( dDate ) + FT_CAL( dDate, 1 ) + + RETURN + +// DEMO Monthly Calendar function. +// nType : 0 -> FT_MONTH, 1 -> FT_ACCTMONTH + +STATIC FUNCTION FT_CAL( dGivenDate, nType ) + + LOCAL nTemp, dTemp, aTemp, cFY_Start, dStart, dEnd + + aTemp := FT_DATECNFG() + cFY_Start := aTemp[ 1 ] + + IF dGivenDate == NIL .OR. !( ValType( dGivenDate ) $ "ND" ) + dGivenDate := Date() + ELSEIF HB_ISNUMERIC( dGivenDate ) + nType := dGivenDate + dGivenDate := Date() + ENDIF + + nType := iif( HB_ISNUMERIC( nType ), nType, 0 ) + + IF nType == 0 + IF SubStr( cFY_Start, 6, 5 ) == "01.01" + ? " Calendar Month Calendar containing " + DToC( dGivenDate ) + ELSE + ? " Fiscal Month Calendar containing " + DToC( dGivenDate ) + ENDIF + + aTemp := FT_MONTH( dGivenDate ) + dStart := aTemp[ 2 ] + dEnd := aTemp[ 3 ] + aTemp[ 2 ] -= FT_DAYTOBOW( aTemp[ 2 ] ) + aTemp[ 3 ] += 6 - FT_DAYTOBOW( aTemp[ 3 ] ) + ELSE + ? " Accounting Month Calendar containing " + DToC( dGivenDate ) + aTemp := FT_ACCTMONTH( dGivenDate ) + ENDIF + + ? + dTemp := aTemp[ 2 ] + + FOR nTemp := 0 TO 6 + ?? PadC( CDOW( dTemp + nTemp ), 10 ) + NEXT + + ? + WHILE dTemp <= aTemp[ 3 ] + FOR nTemp := 1 TO 7 + ?? " " + IF nType == 0 .AND. ( dTemp < dStart .OR. dTemp > dEnd ) + ?? Space( 8 ) + ELSE + ?? dTemp + ENDIF + ?? " " + dTemp++ + NEXT + ? + END + + RETURN NIL + diff --git a/harbour/contrib/hbnf/tests/dectobin.prg b/harbour/contrib/hbnf/tests/dectobin.prg new file mode 100644 index 0000000000..6288cbbc9d --- /dev/null +++ b/harbour/contrib/hbnf/tests/dectobin.prg @@ -0,0 +1,14 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL X + + FOR X := 1 TO 255 + QOut( FT_DEC2BIN( x ) ) + NEXT + + RETURN + diff --git a/harbour/contrib/hbnf/tests/dfile.prg b/harbour/contrib/hbnf/tests/dfile.prg new file mode 100644 index 0000000000..da0624e17a --- /dev/null +++ b/harbour/contrib/hbnf/tests/dfile.prg @@ -0,0 +1,53 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL cInFile := "dfile.prg" + LOCAL CKEY + LOCAL NNCOLOR := 7 + LOCAL NHCOLOR := 15 + LOCAL NCOLSKIP := 5 + LOCAL NRMARGIN := 132 + LOCAL CEXITKEYS := "AABBC " + LOCAL LBROWSE := .F. + LOCAL NSTART := 1 + LOCAL NBUFFSIZE := 4096 + LOCAL GetList := {} + + @ 0, 0 CLEAR + + @ 0, 0 SAY "ENTER FILENAME: " GET CINFILE + @ 1, 0 SAY " FOREGROUND: " GET NNCOLOR PICTURE "999" + @ 2, 0 SAY " HIGHLIGHT: " GET NHCOLOR PICTURE "999" + @ 3, 0 SAY " EXIT KEYS: " GET CEXITKEYS + @ 4, 0 SAY " BUFFER SIZE: " GET NBUFFSIZE PICTURE "9999" + @ 1, 40 SAY "COLUMN INCREMENT: " GET NCOLSKIP PICTURE "999" + @ 2, 40 SAY " MAX LINE SIZE: " GET NRMARGIN PICTURE "999" + @ 3, 40 SAY " BROWSE MODE? " GET LBROWSE PICTURE "Y" + + READ + + /* + * REMEMBER A WINDOW WILL BE ONE SIZE LESS AND GREATER THAN THE PASSED COORD.'S + * + * THE 9TH PARAMETER CONTAINS THE KEYS THAT THE ROUTINE WILL TERMINATE ON + * AND THE hb_BChar(143) represents the F3 key. + * + */ + + @ 4, 9 TO 11, 71 + + FT_DFSETUP( cInFile, 5, 10, 10, 70, nStart, ; + nNColor, nHColor, cExitKeys + hb_BChar( 143 ), ; + lBrowse, nColSkip, nRMargin, nBuffSize ) + + cKey := FT_DISPFILE() + + FT_DFCLOSE() + + @ 20, 0 SAY "Key pressed was: " + "[" + cKey + "]" + + RETURN + diff --git a/harbour/contrib/hbnf/tests/diskfunc.prg b/harbour/contrib/hbnf/tests/diskfunc.prg new file mode 100644 index 0000000000..e0d71a4345 --- /dev/null +++ b/harbour/contrib/hbnf/tests/diskfunc.prg @@ -0,0 +1,11 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cDrv ) + + QOut( "Disk size: " + Str( FT_DSKSIZE( cDrv ) ) ) + QOut( "Free bytes: " + Str( FT_DSKFREE( cDrv ) ) ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/dispmsg.prg b/harbour/contrib/hbnf/tests/dispmsg.prg new file mode 100644 index 0000000000..c695b97e17 --- /dev/null +++ b/harbour/contrib/hbnf/tests/dispmsg.prg @@ -0,0 +1,64 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL cDosScrn + LOCAL nDosRow + LOCAL nDosCol + LOCAL lColor + LOCAL nMaxRow + LOCAL nType + + // color variables + LOCAL cNormH, cNormN + LOCAL cWindH, cWindN + LOCAL cErrH, cErrN + + // main routine starts here + SET SCOREBOARD OFF + + lColor := .T. + + cNormH := iif( lColor, "W+/BG", "W+/N" ) + cNormN := iif( lColor, "N/BG" , "W/N" ) + cWindH := iif( lColor, "W+/B", "W+/N" ) + cWindN := iif( lColor, "W/B" , "W/N" ) + cErrH := iif( lColor, "W+/R", "W+/N" ) + cErrN := iif( lColor, "W/R" , "W/N" ) + + cDosScrn := SaveScreen() + nDosRow := Row() + nDosCol := Col() + SetColor( "W/N" ) + CLS + nMaxRow := MaxRow() + SetBlink( .F. ) + SetColor( cWindN + "*" ) + CLS + SetColor( cNormN ) + + FT_DispMsg( { { "[Esc] To Abort Changes [PgDn] To Continue" }, { cNormN, , cNormH } }, , nMaxRow - 5 ) + + FT_DispMsg( { { "[E]dit [P]rint [D]elete", ; + "[Esc]ape [Alt-Q]" }, ; + { cErrN, cErrN, cErrH } }, , 2 ) + + nType := FT_DispMsg( { { ; + "Create Or Edit [I]nvoice" ,; + "Create Or Edit [O]rder" ,; + "Create Or Edit [B]ack Order" ,; + "Create Or Edit [Q]uote" ,; + "[Esc] To Exit" } ,; + { cWindN, , , , , cWindH } }, "BIOQ" + Chr( K_ESC ) ) + + HB_SYMBOL_UNUSED( nType ) + + SetColor( "W/N" ) + SetCursor( SC_NORMAL ) + SetBlink( .T. ) + RestScreen( , , , , cDosScrn ) + SetPos( nDosRow, nDosCol ) + QUIT + diff --git a/harbour/contrib/hbnf/tests/dosver.prg b/harbour/contrib/hbnf/tests/dosver.prg new file mode 100644 index 0000000000..fb9cea0811 --- /dev/null +++ b/harbour/contrib/hbnf/tests/dosver.prg @@ -0,0 +1,10 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + QOut( "Dos version: " + FT_DOSVER() ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/e2d.prg b/harbour/contrib/hbnf/tests/e2d.prg new file mode 100644 index 0000000000..26757fb445 --- /dev/null +++ b/harbour/contrib/hbnf/tests/e2d.prg @@ -0,0 +1,10 @@ +/* + * $Id$ + */ + +PROCEDURE Main( sNumE ) + + QOut( FT_E2D( sNumE ) ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/elapsed.prg b/harbour/contrib/hbnf/tests/elapsed.prg new file mode 100644 index 0000000000..aecbcd0fdc --- /dev/null +++ b/harbour/contrib/hbnf/tests/elapsed.prg @@ -0,0 +1,22 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL dStart, dEnd, cTimeStart, cTimeEnd, n, aDataTest + + dStart := SToD( "19901128" ) + dEnd := SToD( "19901130" ) + cTimeStart := "08:00:00" + cTimeEnd := "12:10:30" + + aDataTest := FT_ELAPSED( dStart, dEnd, cTimeStart, cTimeEnd ) + 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." ) ) ) + NEXT + + RETURN + diff --git a/harbour/contrib/hbnf/tests/findith.prg b/harbour/contrib/hbnf/tests/findith.prg new file mode 100644 index 0000000000..55847b0738 --- /dev/null +++ b/harbour/contrib/hbnf/tests/findith.prg @@ -0,0 +1,23 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cCk, cStr, nOcc, xCase ) + + LOCAL nFind + + IF PCount() != 4 + QOut( "usage: findith cCk cStr nOcc xCase" ) + QUIT + ENDIF + + xCase := iif( xCase == "Y", .T. , .F. ) + nOcc := Val( nOcc ) + QOut( iif( xCase, "Ignoring ", "Observing " ) + "case:" ) + + QOut( cStr ) + nFind := FT_FINDITH( cCk, cStr, nOcc, xCase ) + QOut( iif( nFind > 0, Space( nFind - 1 ) + "^" , "Not found" ) ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/floptst.prg b/harbour/contrib/hbnf/tests/floptst.prg new file mode 100644 index 0000000000..3323f2cca6 --- /dev/null +++ b/harbour/contrib/hbnf/tests/floptst.prg @@ -0,0 +1,17 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cArg1 ) + + LOCAL nErrCode + + IF HB_ISSTRING( cArg1 ) + nErrCode := FT_FLOPTST( Asc( Upper( cArg1 ) ) - Asc( "A" ) ) + OutStd( "Return Code is " + hb_ntos( nErrCode ) + hb_eol() ) + ELSE + OutStd( "Usage: floptst cDrive" + hb_eol() + " where cDrive is 'A' or 'B' etc..." + hb_eol() ) + ENDIF + + RETURN + diff --git a/harbour/contrib/hbnf/tests/gcd.prg b/harbour/contrib/hbnf/tests/gcd.prg new file mode 100644 index 0000000000..9fb920bf33 --- /dev/null +++ b/harbour/contrib/hbnf/tests/gcd.prg @@ -0,0 +1,10 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cNum1, cNum2 ) + + OutStd( Str( FT_GCD( Val( cNum1 ), Val( cNum2 ) ) ) + hb_eol() ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/hex2dec.prg b/harbour/contrib/hbnf/tests/hex2dec.prg new file mode 100644 index 0000000000..fcafa7e3cd --- /dev/null +++ b/harbour/contrib/hbnf/tests/hex2dec.prg @@ -0,0 +1,10 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cHexNum ) + + QOut( FT_HEX2DEC( cHexNum ) ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/isshare.prg b/harbour/contrib/hbnf/tests/isshare.prg new file mode 100644 index 0000000000..70272a00aa --- /dev/null +++ b/harbour/contrib/hbnf/tests/isshare.prg @@ -0,0 +1,21 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL nLoaded := ft_isshare() + + DO CASE + CASE nLoaded == 0 + QOut( "Share not loaded, but ok to load" ) + CASE nLoaded == 1 + QOut( "Share not loaded, but NOT ok to load!" ) + CASE nLoaded == 255 + QOut( "Share is loaded!" ) + ENDCASE + + QOut( "Retcode: " + Str( nLoaded ) ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/linked.prg b/harbour/contrib/hbnf/tests/linked.prg new file mode 100644 index 0000000000..894996d57d --- /dev/null +++ b/harbour/contrib/hbnf/tests/linked.prg @@ -0,0 +1,27 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL aString := { ; + "RTrim('abc ')" ,; + "NotARealFunc()" ,; + "FT_DispMsg()" ,; + 'RTrim(cVar+"abc"+Left(cString)), Found()' ,; + "IsItLinked()" ,; + "lRetVal := Found()" ,; + "!EOF() .AND. Month(Date())=12 .AND. YeeHa()" ,; + "!EOF() .AND. Month(Date())=12" ,; + "!EOF() .AND. Month(Date(YeeHa()))=12" ,; + "Left(SubStr(nNum,4,Val(cChar+Asc(c))))" ,; + "EOF(>> Note: Syntax IS NOT checked! <<)" } + + CLS + @ 1, 0 SAY "String Tested Result" + @ 2, 0 TO 2, MaxCol() + AEval( aString, {| ele | QOut( ele, Space( 45 - Len( ele ) ), FT_Linked( ele ) ) } ) + @ MaxRow() - 2, 0 + + RETURN + diff --git a/harbour/contrib/hbnf/tests/menu1.prg b/harbour/contrib/hbnf/tests/menu1.prg new file mode 100644 index 0000000000..ff61d128e6 --- /dev/null +++ b/harbour/contrib/hbnf/tests/menu1.prg @@ -0,0 +1,128 @@ +/* + * $Id$ + */ + +// DUMMY PROCEDURE NAME SO "CCMDLINE" WILL BE LOCAL + +PROCEDURE Main( cCmdLine ) + + LOCAL sDosScrn, nDosRow, nDosCol, lColor + + // my approach to color variables + // see colorchg.arc on NANFORUM + LOCAL cNormN + LOCAL cWindN + LOCAL cErrH + LOCAL cErrN + + // options on menu bar + LOCAL aColors + LOCAL aBar := { " ENTER/EDIT ", " REPORTS ", " DISPLAY ", " MAINTENANCE ", " QUIT " } + LOCAL aOptions[ Len( aBar ) ] + AEval( aBar, {| x, i | HB_SYMBOL_UNUSED( x ), aOptions[ i ] := { {}, {}, {} } } ) + + cCmdLine := iif( cCmdLine == NIL, "", cCmdLine ) + + lColor := iif( "MONO" $ Upper( cCmdLine ), .F. , IsColor() ) + + // Border, Box, Bar, Current, Unselected + 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[ 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[ 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. ) + + // main routine starts here + SET SCOREBOARD OFF + + cNormN := iif( lColor, "N/G" , "W/N" ) + cWindN := iif( lColor, "W/B" , "W/N" ) + cErrH := iif( lColor, "W+/R", "W+/N" ) + cErrN := iif( lColor, "W/R" , "W/N" ) + + SAVE SCREEN TO sDosScrn + nDosRow := Row() + nDosCol := Col() + SetColor( "w/n" ) + CLS + NoSnow( "NOSNOW" $ Upper( cCmdLine ) ) + IF "VGA" $ Upper( cCmdLine ) + SetMode( 50, 80 ) + ENDIF + t_nMaxRow := MaxRow() + SetBlink( .F. ) + SetColor( cWindN + "*" ) + CLS + SetColor( cNormN ) + @ t_nMaxRow, 0 + @ t_nMaxRow, 0 SAY hb_UTF8ToStr( " FT_MENU1 1.0 │ " ) + @ t_nMaxRow, 16 SAY "WRITTEN BY PAUL FERRARA [76702,556] FOR NANFORUM.LIB" + @ t_nMaxRow, 69 SAY hb_UTF8ToStr( "│ " ) + DToC( Date() ) + + SetColor( cErrH ) + @ t_nMaxRow - 11, 23, t_nMaxRow - 3, 56 BOX hb_UTF8ToStr( "┌─┐│┘─└│ " ) + @ t_nMaxRow - 9, 23 SAY hb_UTF8ToStr( "├────────────────────────────────┤" ) + SetColor( cErrN ) + @ t_nMaxRow - 10, 33 SAY "Navigation Keys" + @ t_nMaxRow - 8, 25 SAY "LeftArrow RightArrow Alt-E" + @ t_nMaxRow - 7, 25 SAY "Home End Alt-R" + @ t_nMaxRow - 6, 25 SAY "Tab Shift-Tab Alt-D" + @ t_nMaxRow - 5, 25 SAY "PgUp PgDn Alt-M" + @ t_nMaxRow - 4, 25 SAY "Enter ESCape Alt-Q" + SetColor( cNormN ) + + FT_MENU1( aBar, aOptions, aColors ) + + SetColor( "W/N" ) + SetCursor( SC_NORMAL ) + SetBlink( .T. ) + IF "VGA" $ Upper( cCmdLine ) + SetMode( 25, 80 ) + ENDIF + RESTORE SCREEN FROM sDosScrn + SetPos( nDosRow, nDosCol ) + QUIT + +FUNCTION fubar() + + LOCAL OldColor := SetColor( "W/N" ) + + CLS + QOut( "Press Any Key" ) + Inkey( 0 ) + SetColor( OldColor ) + + RETURN .T. diff --git a/harbour/contrib/hbnf/tests/metaph.prg b/harbour/contrib/hbnf/tests/metaph.prg new file mode 100644 index 0000000000..a857fe05b1 --- /dev/null +++ b/harbour/contrib/hbnf/tests/metaph.prg @@ -0,0 +1,101 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL aNames := {} + + Set( _SET_SCOREBOARD, .F. ) + Set( _SET_COLOR, "W/B" ) + CLS + + // Demo will create an array of names and display in 3 columns + // _ftRow() and _ftCol() will calculate the screen co-ordinates + // by evaluating the element number + + AAdd( aNames, "Adams" ) + AAdd( aNames, "Addams" ) + AAdd( aNames, "Atoms" ) + AAdd( aNames, "Adamson" ) + AAdd( aNames, "Cajun" ) + AAdd( aNames, "Cagen" ) + AAdd( aNames, "Cochy" ) + AAdd( aNames, "Cocci" ) + AAdd( aNames, "Smith" ) + AAdd( aNames, "Smythe" ) + AAdd( aNames, "Naylor" ) + AAdd( aNames, "Nailer" ) + AAdd( aNames, "Holberry" ) + AAdd( aNames, "Wholebary" ) + AAdd( aNames, "Jackson" ) + AAdd( aNames, "Jekksen" ) + AAdd( aNames, "The Source" ) + AAdd( aNames, "The Sores" ) + AAdd( aNames, "Jones" ) + AAdd( aNames, "Johns" ) + AAdd( aNames, "Lennon" ) + AAdd( aNames, "Lenin" ) + AAdd( aNames, "Fischer" ) + AAdd( aNames, "Fisher" ) + AAdd( aNames, "O'Donnell" ) + AAdd( aNames, "O Donald" ) + AAdd( aNames, "Pugh" ) + AAdd( aNames, "Pew" ) + AAdd( aNames, "Heimendinger" ) + AAdd( aNames, "Hymendinker" ) + AAdd( aNames, "Knight" ) + AAdd( aNames, "Nite" ) + AAdd( aNames, "Lamb" ) + AAdd( aNames, "Lamb Chops" ) + AAdd( aNames, "Stephens" ) + AAdd( aNames, "Stevens" ) + AAdd( aNames, "Neilson" ) + AAdd( aNames, "Nelson" ) + AAdd( aNames, "Tchaikovski" ) + AAdd( aNames, "Chikofski" ) + AAdd( aNames, "Caton" ) + AAdd( aNames, "Wright" ) + AAdd( aNames, "Write" ) + AAdd( aNames, "Right" ) + AAdd( aNames, "Manual" ) + AAdd( aNames, "Now" ) + AAdd( aNames, "Wheatabix" ) + AAdd( aNames, "Science" ) + AAdd( aNames, "Cinzano" ) + AAdd( aNames, "Lucy" ) + AAdd( aNames, "Reece" ) + AAdd( aNames, "Righetti" ) + AAdd( aNames, "Oppermann" ) + AAdd( aNames, "Bookkeeper" ) + AAdd( aNames, "McGill" ) + AAdd( aNames, "Magic" ) + AAdd( aNames, "McLean" ) + AAdd( aNames, "McLane" ) + AAdd( aNames, "Maclean" ) + AAdd( aNames, "Exxon" ) + + // display names and metaphones in 3 columns on screen + AEval( aNames, ; + {| cName, nElem | ; + SetPos( _ftRow( nElem ), _ftCol( nElem ) ), ; + QQOut( PadR( cName, 18, "." ) + FT_METAPH( cName ) ) ; + } ) + + SetPos( 21, 00 ) + QUIT + +//------------------------------------------------ + +STATIC FUNCTION _ftRow( nElem ) // Determine which row to print on + + RETURN iif( nElem > 40, nElem - 40, iif( nElem > 20, nElem - 20, nElem ) ) + +//------------------------------------------------ + +STATIC FUNCTION _ftCol( nElem ) // Determine which column to start print + + RETURN iif( nElem > 40, 55, iif( nElem > 20, 28, 1 ) ) + +//------------------------------------------------ + diff --git a/harbour/contrib/hbnf/tests/miltime.prg b/harbour/contrib/hbnf/tests/miltime.prg new file mode 100644 index 0000000000..8782bfe1d9 --- /dev/null +++ b/harbour/contrib/hbnf/tests/miltime.prg @@ -0,0 +1,39 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + CLS + ? "am-pm" + ? ft_civ2mil( " 5:40 pm" ) + ? ft_civ2mil( "05:40 pm" ) + ? ft_civ2mil( " 5:40 PM" ) + ? ft_civ2mil( " 5:40 am" ) + ? ft_civ2mil( "05:40 am" ) + ? ft_civ2mil( " 5:40 AM" ) + ? + Inkey( 0 ) + CLS + ? "noon-midnight" + ? ft_civ2mil( "12:00 m" ) + ? ft_civ2mil( "12:00 M" ) + ? ft_civ2mil( "12:00 m" ) + ? ft_civ2mil( "12:00 n" ) + ? ft_civ2mil( "12:00 N" ) + ? ft_civ2mil( "12:00 n" ) + ? + Inkey( 0 ) + CLS + ? "errors in noon-midnight" + ? ft_civ2mil( "12:01 n" ) + ? ft_civ2mil( "22:00 n" ) + ? ft_civ2mil( "12:01 m" ) + ? ft_civ2mil( "22:00 n" ) + ? + ? "sys to mil" + ? Time() + ? ft_sys2mil() + + RETURN + diff --git a/harbour/contrib/hbnf/tests/mouse1.prg b/harbour/contrib/hbnf/tests/mouse1.prg new file mode 100644 index 0000000000..dcfc44b075 --- /dev/null +++ b/harbour/contrib/hbnf/tests/mouse1.prg @@ -0,0 +1,188 @@ +/* + * $Id$ + */ + +PROCEDURE Main( nRow, nCol ) + + // Pass valid row and column values for different video modes to change modes + + LOCAL nX, nY, cSavClr + LOCAL cSavScr := SaveScreen( 0, 0, MaxRow(), MaxCol() ) + LOCAL nSaveRow := MaxRow() + 1, nSaveCol := MaxCol() + 1 + LOCAL nMinor, nType, nIRQ + LOCAL aType := { "Bus", "Serial", "InPort", "PS/2", "HP" } + LOCAL nHoriz, nVert, nDouble + + IF nRow == NIL + nRow := MaxRow() + 1 + ELSE + nRow := Val( nRow ) + ENDIF + + IF nCol == NIL + nCol := MaxCol() + 1 + ELSE + nCol := Val( nCol ) + ENDIF + + IF !FT_MINIT() + @ MaxRow(), 0 SAY "Mouse driver is not installed!" + + RETURN + ENDIF + + // ..... Set up the screen + cSavClr := SetColor( "w/n" ) + @ 0, 0, MaxRow(), MaxCol() BOX hb_UTF8ToStr( "░░░░░░░░░" ) + + SetColor( "GR+/RB" ) +// Scroll( 7, 2, 19, 63, 0 ) + @ 7, 2 TO 20, 63 + + @ 17, 10 TO 19, 40 double + + SetColor( "N/W" ) + @ 18, 11 SAY " Double Click here to Quit " + + SetColor( "GR+/RB" ) + + // ..... Start the demo + + @ MaxRow(), 0 SAY "Driver version: " + ; + AllTrim( Str( FT_MVERSION( @nMinor, @nType, @nIRQ ), 2, 0 ) ) + "." + ; + AllTrim( Str( nMinor, 2, 0 ) ) + @ Row(), Col() SAY " " + aType[ nType ] + " mouse using IRQ " + Str( nIRQ, 1, 0 ) + + FT_MGETSENS( @nHoriz, @nVert, @nDouble ) // Get the current sensitivities + FT_MSETSENS( 70, 70, 60 ) // Bump up the sensitivity of the mouse + + FT_MSHOWCRS() + FT_MSETCOORD( 10, 20 ) // just an arbitrary place for demo + + // put the unchanging stuff + + DevPos( 9, 10 ) + DevOut( "FT_MMICKEYS :" ) + + DevPos( 10, 10 ) + DevOut( "FT_MGETPOS :" ) + + DevPos( 11, 10 ) + DevOut( "FT_MGETX :" ) + + DevPos( 12, 10 ) + DevOut( "FT_MGETY :" ) + + DevPos( 13, 10 ) + DevOut( "FT_MGETCOORD:" ) + + DevPos( 14, 10 ) + DevOut( "FT_MBUTPRS :" ) + + DevPos( 16, 10 ) + DevOut( "FT_MBUTREL :" ) + + nX := nY := 1 + DO WHILE .T. + + // If we are not moving then wait for movement. + // This whole demo is a bit artificial in its requirements when compared + // to a "normal" CLIPPER program so some of these examples are a bit out of + // the ordinary. + + DO WHILE nX == 0 .AND. nY == 0 + FT_MMICKEYS( @nX, @nY ) + ENDDO + // tell the mouse driver where updates will be taking place so it can hide + // the cursor when necessary. + + FT_MCONOFF( 9, 23, 16, 53 ) + + DevPos( 9, 23 ) + DevOut( nX ) + DevOut( nY ) + + DevPos( 10, 23 ) + DevOut( FT_MGETPOS( @nX, @nY ) ) + DevOut( nX ) + DevOut( nY ) + + DevPos( 11, 23 ) + DevOut( FT_MGETX() ) + + DevPos( 12, 23 ) + DevOut( FT_MGETY() ) + + DevPos( 13, 23 ) + DevOut( FT_MGETCOORD( @nX, @nY ) ) + DevOut( nX ) + DevOut( nY ) + + nX := nY := 0 + DevPos( 14, 23 ) + DevOut( FT_MBUTPRS( 1 ) ) + DevOut( FT_MBUTPRS( 0,, nX, nY ) ) + DevPos( 15, 23 ) + + // show only the last Press since it flashes by so quickly + + IF nX != 0 .OR. nY != 0 + DevOut( nX ) + DevOut( nY ) + ENDIF + + nX := nY := 0 + DevPos( 16, 23 ) + DevOut( FT_MBUTREL( 0,, @nX, @nY ) ) + + // show only the last release since it flashes by so quickly + + IF nX != 0 .OR. nY != 0 + DevOut( nX ) + DevOut( nY ) + ENDIF + + // Restore the cursor if it has been hidden + + FT_MSHOWCRS() + + IF FT_MINREGION( 18, 11, 18, 39 ) + + // Change the type of cursor when in the box. Just slightly different than the + // normal. The character is shown in high intensity. + + FT_MDEFCRS( 0, 32767, 32512 ) + IF FT_MDBLCLK( 2, 0, 0.8 ) + EXIT + ENDIF + ENDIF + + IF FT_MINREGION( 18, 11, 18, 39 ) + + // Change the type of cursor when in the box. Just slightly different than the + // normal. The character is shown in high intensity. + + FT_MDEFCRS( 0, 32767, 32512 ) + ELSE + + // Put the cursor back to normal mode + + FT_MDEFCRS( 0, 30719, 30464 ) + ENDIF + + FT_MMICKEYS( @nX, @nY ) + ENDDO + + FT_MHIDECRS() + + SetMode( nSaveRow, nSaveCol ) + SetColor( cSavClr ) + RestScreen( 0, 0, MaxRow(), MaxCol(), cSavScr ) + DevPos( MaxRow(), 0 ) + + // Reset sensitivity + + FT_MSETSENS( nHoriz, nVert, nDouble ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/mouse2.prg b/harbour/contrib/hbnf/tests/mouse2.prg new file mode 100644 index 0000000000..3f861a820f --- /dev/null +++ b/harbour/contrib/hbnf/tests/mouse2.prg @@ -0,0 +1,194 @@ +/* + * $Id$ + */ + +// Pass valid row and column values for different video modes to change modes + +PROCEDURE Main( nRow, nCol ) + + LOCAL nX, nY, cSavClr + LOCAL cSavScr := SaveScreen( 0, 0, MaxRow(), MaxCol() ) + LOCAL nSaveRow := MaxRow() + 1, nSaveCol := MaxCol() + 1 + LOCAL nMinor, nType, nIRQ + LOCAL aType := { "Bus", "Serial", "InPort", "PS/2", "HP" } + LOCAL nHoriz, nVert, nDouble + + IF nRow == NIL + nRow := MaxRow() + 1 + ELSE + nRow := Val( nRow ) + ENDIF + + IF nCol == NIL + nCol := MaxCol() + 1 + ELSE + nCol := Val( nCol ) + ENDIF + + IF ! SetMode( nRow, nCol ) + @ MaxRow(), 0 SAY "Mode Change unsuccessful:" + Str( nRow, 2, 0 ) + " by"; + + Str( nCol, 3, 0 ) + RETURN + ENDIF + + IF Empty( FT_MINIT() ) + @ MaxRow(), 0 SAY "Mouse driver is not installed!" + SetMode( nSaveRow, nSaveCol ) + RETURN + ENDIF + + // ..... Set up the screen + cSavClr := SetColor( "w/n" ) + @ 0, 0, MaxRow(), MaxCol() BOX hb_UTF8ToStr( "░░░░░░░░░" ) + + SetColor( "GR+/RB" ) + Scroll( 7, 2, 19, 63, 0 ) + @ 7, 2 TO 20, 63 + + @ 17, 10 TO 19, 40 double + + SetColor( "N/W" ) + @ 18, 11 SAY " Double Click here to Quit " + + SetColor( "GR+/RB" ) + + // ..... Start the demo + + @ MaxRow(), 0 SAY "Driver version: " + ; + AllTrim( Str( FT_MVERSION( @nMinor, @nType, @nIRQ ), 2, 0 ) ) + "." + ; + AllTrim( Str( nMinor, 2, 0 ) ) + @ Row(), Col() SAY " " + aType[ nType ] + " mouse using IRQ " + Str( nIRQ, 1, 0 ) + + FT_MGETSENS( @nHoriz, @nVert, @nDouble ) // Get the current sensitivities + FT_MSETSENS( 70, 70, 60 ) // Bump up the sensitivity of the mouse + + FT_MSHOWCRS() + FT_MSETCOORD( 10, 20 ) // just an arbitrary place for demo + + // put the unchanging stuff + + DevPos( 9, 10 ) + DevOut( "FT_MMICKEYS :" ) + + DevPos( 10, 10 ) + DevOut( "FT_MGETPOS :" ) + + DevPos( 11, 10 ) + DevOut( "FT_MGETX :" ) + + DevPos( 12, 10 ) + DevOut( "FT_MGETY :" ) + + DevPos( 13, 10 ) + DevOut( "FT_MGETCOORD:" ) + + DevPos( 14, 10 ) + DevOut( "FT_MBUTPRS :" ) + + DevPos( 16, 10 ) + DevOut( "FT_MBUTREL :" ) + + nX := nY := 1 + DO WHILE .T. + + // If we are not moving then wait for movement. + // This whole demo is a bit artificial in its requirements when compared + // to a "normal" CLIPPER program so some of these examples are a bit out of + // the ordinary. + + DO WHILE nX == 0 .AND. nY == 0 + FT_MMICKEYS( @nX, @nY ) + ENDDO + // tell the mouse driver where updates will be taking place so it can hide + // the cursor when necessary. + + FT_MCONOFF( 9, 23, 16, 53 ) + + DevPos( 9, 23 ) + DevOut( nX ) + DevOut( nY ) + + DevPos( 10, 23 ) + DevOut( FT_MGETPOS( @nX, @nY ) ) + DevOut( nX ) + DevOut( nY ) + + DevPos( 11, 23 ) + DevOut( FT_MGETX() ) + + DevPos( 12, 23 ) + DevOut( FT_MGETY() ) + + DevPos( 13, 23 ) + DevOut( FT_MGETCOORD( @nX, @nY ) ) + DevOut( nX ) + DevOut( nY ) + + nX := nY := 0 + DevPos( 14, 23 ) + DevOut( FT_MBUTPRS( 1 ) ) + DevOut( FT_MBUTPRS( 0,, nX, nY ) ) + DevPos( 15, 23 ) + + // show only the last Press since it flashes by so quickly + + IF nX != 0 .OR. nY != 0 + DevOut( nX ) + DevOut( nY ) + ENDIF + + nX := nY := 0 + DevPos( 16, 23 ) + DevOut( FT_MBUTREL( 0,, @nX, @nY ) ) + + // show only the last release since it flashes by so quickly + + IF nX != 0 .OR. nY != 0 + DevOut( nX ) + DevOut( nY ) + ENDIF + + // Restore the cursor if it has been hidden + + FT_MSHOWCRS() + + IF FT_MINREGION( 18, 11, 18, 39 ) + + // Change the type of cursor when in the box. Just slightly different than the + // normal. The character is shown in high intensity. + + FT_MDEFCRS( 0, 32767, 32512 ) + IF FT_MDBLCLK( 2, 0, 0.8 ) + EXIT + ENDIF + ENDIF + + IF FT_MINREGION( 18, 11, 18, 39 ) + + // Change the type of cursor when in the box. Just slightly different than the + // normal. The character is shown in high intensity. + + FT_MDEFCRS( 0, 32767, 32512 ) + ELSE + + // Put the cursor back to normal mode + + FT_MDEFCRS( 0, 30719, 30464 ) + ENDIF + + FT_MMICKEYS( @nX, @nY ) + ENDDO + + FT_MHIDECRS() + + SetMode( nSaveRow, nSaveCol ) + SetColor( cSavClr ) + RestScreen( 0, 0, MaxRow(), MaxCol(), cSavScr ) + DevPos( MaxRow(), 0 ) + + // Reset sensitivity + + FT_MSETSENS( nHoriz, nVert, nDouble ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/netpv.prg b/harbour/contrib/hbnf/tests/netpv.prg new file mode 100644 index 0000000000..31bc748fad --- /dev/null +++ b/harbour/contrib/hbnf/tests/netpv.prg @@ -0,0 +1,10 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + ? FT_NETPV( 10000, 10, { 10000, 15000, 16000, 17000 } ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/nftest.prg b/harbour/contrib/hbnf/tests/nftest.prg deleted file mode 100644 index 67c33c45fb..0000000000 --- a/harbour/contrib/hbnf/tests/nftest.prg +++ /dev/null @@ -1,1096 +0,0 @@ -/* - * $Id$ - */ - -/* - Simplest demo program to show usage for libnf -*/ - -#include "directry.ch" -#include "inkey.ch" - -// Default heading, column, footer separators -#define DEF_HSEP "=+=" -#define DEF_CSEP " | " -#define DEF_FSEP "=+=" - -// Default info for tb_methods section -#define KEY_ELEM 1 -#define BLK_ELEM 2 - - STATIC nWait := 0.2 - -FUNCTION Main() - - LOCAL var0, nstart, nstop, nelapsed, nCtr - LOCAL aRet[ 8 ], i - LOCAL ar[ 3, 26 ], aBlocks[ 3 ], aHeadings[ 3 ], nElem := 1, bGetFunc, cRet - - nKey := 0 - - // - // Cover - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "Next screens will be a functions list contained in the library libnf," - ? "a port in xHarbour of the Nanforum Library for Clipper. The list is" - ? "organized as the original Norton Guide for the library. After the list" - ? "for each group of functions will be a demo of them." - ? - ? "A few new functions are added to the library libnf in order to expand" - ? "is power in this new xBase chapter. The demo of this function will be" - ? "in the group where they must included." - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - SET KEY K_F1 TO - - // - // Array group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF ARRAY FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_AADDITION() Add elements unique of source array to target array" - ? "FT_AAVG() Average numeric values in an array" - ? "FT_ADESSORT() Sort an array in descending order" - ? "FT_AEMAXLEN() Find longest element within an array" - ? "FT_AEMINLEN() Find shortest element within an array" - ? "FT_AMEDIAN() Find middle value in array, or average of two middle values" - ? "FT_ANOMATCHES() Find the number of array elements meeting a condition" - ? "FT_AREDIT() 2 dimensional array editing function using TBrowse" - ? "FT_ASUM() Sum the elements of an array" - ? "FT_RESTARR() Restore a Clipper array from a disc file" - ? "FT_SAVEARR() Save Clipper array to a disc file." - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_ADDITION example - // - SetColor( "w+/b" ) - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AADDITION" - ? Replicate( "-", 78 ) - ? - aList1 := { "apple", "orange", "pear" } - aList2 := { "apple ", "banana", "PEAR" } - ? "aList1 : " - AEval( aList1, { |x| QQOut( x + "," ) } ) - ? - ? "aList2 : " - AEval( aList2, { |x| QQOut( x + "," ) } ) - ? - - nstart := Seconds() - FOR nCtr := 1 TO 1000 - var0 := FT_AADDITION( aList1, aList2 ) - NEXT - nstop := Seconds() - nelapsed := nstop - nstart - ? "time for 1000 merges:", nelapsed - ? - ? PadR( "FT_AADDITION( aList1, aList2 ) ->", 44 ) - AEval( var0, { |x| QQOut( x + "," ) } ) - ? - var0 := FT_AADDITION( aList1, aList2, , .F. ) - ? PadR( "FT_AADDITION( aList1, aList2, , .F. ) ->", 44 ) - AEval( var0, { |x| QQOut( x + "," ) } ) - ? - var0 := FT_AADDITION( aList1, aList2, .F. , .F. ) - ? PadR( "FT_AADDITION( aList1, aList2, .F., .F. ) ->", 44 ) - AEval( var0, { |x| QQOut( x + "," ) } ) - ? - RELEASE aList, aList2 - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_AAVG example - // - aSubTotals := { 1, 1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 2 } - SetColor( "w+/b" ) - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AAVG" - ? Replicate( "-", 78 ) - ? - ? "aSubTotals : " - AEval( aSubTotals, { |x| QQOut( Transform( x, "9.99" ) + "," ) } ) - ? - var0 := FT_AAVG( aSubTotals ) - ? PadR( "FT_AAVG( aSubTotals ) ->", 44 ) + Transform( var0, "9.99" ) - ? - var0 := FT_AAVG( aSubTotals, 2, 4 ) - ? PadR( "FT_AAVG( aSubTotals, 2, 4 ) ->", 44 ) + Transform( var0, "9.99" ) - ? - var0 := FT_AAVG( aSubTotals, 5 ) - ? PadR( "FT_AAVG( aSubTotals, 5 ) ->", 44 ) + Transform( var0, "9.99" ) - ? - var0 := FT_AAVG( aSubTotals, , 10 ) - ? PadR( "FT_AAVG( aSubTotals, , 10 ) ->", 44 ) + Transform( var0, "9.99" ) - ? - RELEASE aSubTotals - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_ADESSORT example - // - SetColor( "w+/b" ) - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_ADESSORT" - ? Replicate( "-", 78 ) - ? - ? "aNames : " - aNames := { "Mary", "Albert" , "John", "Frank", "Daniel", "Giuliano" } - AEval( aNames, { |x| QQOut( x + "," ) } ) - ? - aNames := { "Mary", "Albert" , "John", "Frank", "Daniel", "Giuliano" } - var0 := FT_ADESSORT( aNames ) - ? PadR( "FT_ADESSORT( aNames ) ->", 30 ) - AEval( var0, { |x| QQOut( x + "," ) } ) - ? - aNames := { "Mary", "Albert" , "John", "Frank", "Daniel", "Giuliano" } - var0 := FT_ADESSORT( aNames, 3 ) - ? PadR( "FT_ADESSORT( aNames, 3 ) ->", 30 ) - AEval( var0, { |x| QQOut( x + "," ) } ) - ? - aNames := { "Mary", "Albert" , "John", "Frank", "Daniel", "Giuliano" } - var0 := FT_ADESSORT( aNames, , 3 ) - ? PadR( "FT_ADESSORT( aNames, , 3 ) ->", 30 ) - AEval( var0, { |x| QQOut( x + "," ) } ) - ? - aNames := { "Mary", "Albert" , "John", "Frank", "Daniel", "Giuliano" } - var0 := FT_ADESSORT( aNames, 2, 5 ) - ? PadR( "FT_ADESSORT( aNames, 2, 5 ) ->", 30 ) - AEval( var0, { |x| QQOut( x + "," ) } ) - ? - RELEASE aNames - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_AEMAXLEN example - // - SetColor( "w+/b" ) - myarray1 := Directory() - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AEMAXLEN" - ? Replicate( "-", 78 ) - ? - ? "myarray1 := DIRECTORY()" - ? -// aEval( myarray1, {|v| qout( padr(v[1],12), v[2], v[3], v[4], v[5] ) } ) -// ? - var0 := FT_AEMAXLEN( myarray1 ) - ? PadR( "FT_AEMAXLEN( myarray1 ) ->", 30 ) - ?? var0 - ? - var0 := FT_AEMAXLEN( myarray1, 2 ) - ? PadR( "FT_AEMAXLEN( myarray1, 2 ) ->", 30 ) - ?? var0 - ? - var0 := FT_AEMAXLEN( myarray1, 3 ) - ? PadR( "FT_AEMAXLEN( myarray1, 3 ) ->", 30 ) - ?? var0 - ? - var0 := FT_AEMAXLEN( ATail( myarray1 ) ) - ? PadR( "FT_AEMAXLEN( aTail( myarray1 ) ) ->", 30 ) - ?? var0 - ? - RELEASE myarray1 - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_AEMINLEN example - // - SetColor( "w+/b" ) - myarray1 := Directory() - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AEMINLEN" - ? Replicate( "-", 78 ) - ? - ? "myarray1 := DIRECTORY()" - ? -// 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 - ? - var0 := FT_AEMINLEN( myarray1, 2 ) - ? PadR( "FT_AEMINLEN( myarray1,2 ) ->", 30 ) - ?? var0 - ? - var0 := FT_AEMINLEN( myarray1[2] ) - ? PadR( "FT_AEMINLEN( myarray1[2] ) ->", 30 ) - ?? var0 - ? - var0 := FT_AEMINLEN( myarray1, 3 ) - ? PadR( "FT_AEMINLEN( myarray1,3 ) ->", 30 ) - ?? var0 - ? - RELEASE myarray1 - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_AEMEDIAN example - // - SetColor( "w+/b" ) - myarray0 := Directory() - myarray1 := {} - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AMEDIAN" - ? Replicate( "-", 78 ) - ? - ? "myarray0 := DIRECTORY()" - ? -// aEval( myarray0, {|v| qout( padr(v[1],12), v[2], v[3], v[4], v[5] ) } ) -// ? - AEval( myarray0, { |x| AAdd( myarray1, x[ F_SIZE ] ) } ) - var0 := FT_AMEDIAN( myarray1 ) - ? PadR( "FT_AMEDIAN( myarray1 ) ->", 35 ) - ?? var0 - ? - var0 := FT_AMEDIAN( myarray1, 2 ) - ? PadR( "FT_AMEDIAN( myarray1, 2 ) ->", 35 ) - ?? var0 - ? - var0 := FT_AMEDIAN( myarray1, , 9 ) - ? PadR( "FT_AMEDIAN( myarray1, , 9 ) ->", 35 ) - ?? var0 - ? - var0 := FT_AMEDIAN( myarray1, 8, 40 ) - ? PadR( "FT_AMEDIAN( myarray1, 8, 40 ) ->", 35 ) - ?? var0 - ? - RELEASE myarray0, myarray1 - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_ANOMATCHES example - // - SetColor( "w+/b" ) - aNames := { "Mary", "Albert" , "John", "Frank", "Daniel", "Giuliano" } - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_ANOMATCHES" - ? Replicate( "-", 78 ) - ? - ? "myarray0 := DIRECTORY()" - ? - ? "aNames : " - AEval( aNames, { |x| QQOut( x + "," ) } ) - ? - var0 := FT_ANOMATCHES( aNames, { |x| At( "a", x ) > 0 } ) - ? PadR( 'FT_ANOMATCHES( aNames, { |x| at( "a", x ) > 0 } ) ->', 60 ) - ?? var0 - ? - var0 := FT_ANOMATCHES( aNames, { |x| At( "an", x ) > 0 } ) - ? PadR( 'FT_ANOMATCHES( aNames, { |x| at( "an", x ) > 0 } ) ->', 60 ) - ?? var0 - ? - var0 := FT_ANOMATCHES( aNames, { |x| At( "an", x ) > 0 }, 1, 3 ) - ? PadR( 'FT_ANOMATCHES( aNames, { |x| at( "an", x ) > 0 }, 1, 3 ) ->', 60 ) - ?? var0 - ? - RELEASE aNames - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_AREDIT example - // - SetColor( "w+/b" ) - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AREDIT" - ? Replicate( "-", 78 ) - // set up 2 dimensional array ar[] - FOR i := 1 TO 26 - ar[1, i] := i // 1 -> 26 Numeric - ar[2, i] := Chr( i + 64 ) // "A" -> "Z" Character - ar[3, i] := Chr( 91 - i ) // "Z" -> "A" Character - NEXT i - // Set Up aHeadings[] for column headings - aHeadings := { "Numbers", "Letters", "Reverse" } - // Set Up Blocks Describing Individual Elements in Array ar[] - aBlocks[1] := {|| Str( ar[1, nElem], 2 ) } // to prevent default 10 spaces - aBlocks[2] := {|| ar[2, nElem] } - aBlocks[3] := {|| ar[3, nElem] } - // Set up TestGet() as bGetFunc - bGetFunc := {|b, ar, nDim, nElem|TestGet( b, ar, nDim, nElem ) } - SET SCOREBOARD OFF - @ 21, 4 SAY "Use Cursor Keys To Move Between Fields, = Delete Row, = Add Row" - @ 22, 7 SAY " = Quit Array Edit, or Edits Element" - SetColor( "N/W, W/N, , , W/N" ) - cRet := FT_ArEdit( 3, 5, 18, 75, ar, @nElem, aHeadings, aBlocks, bGetFunc ) - SetColor( "w+/b" ) - @ 24, 0 - @ 23, 0 - @ 22, 0 - @ 21, 0 - ? "Return Value :", cRet - ? "Lastkey() = ESC:", LastKey() == K_ESC - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_ASUM example - // - aSubTotals := { 1, 1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 2 } - SetColor( "w+/b" ) - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_ASUM" - ? Replicate( "-", 78 ) - ? - ? "aSubTotals : " - AEval( aSubTotals, { |x| QQOut( Transform( x, "999.99" ) + "," ) } ) - ? - var0 := FT_ASUM( aSubTotals ) - ? PadR( "FT_ASUM( aSubTotals ) ->", 44 ) + Transform( var0, "999.99" ) - ? - var0 := FT_ASUM( aSubTotals, 2, 4 ) - ? PadR( "FT_ASUM( aSubTotals, 2, 4 ) ->", 44 ) + Transform( var0, "999.99" ) - ? - var0 := FT_ASUM( aSubTotals, 5 ) - ? PadR( "FT_ASUM( aSubTotals, 5 ) ->", 44 ) + Transform( var0, "999.99" ) - ? - var0 := FT_ASUM( aSubTotals, , 10 ) - ? PadR( "FT_ASUM( aSubTotals, , 10 ) ->", 44 ) + Transform( var0, "999.99" ) - ? - RELEASE aSubTotals - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_RESTARR AND FT_SAVEARR example - // - aArray := { { "Invoice 1", SToD( "19910415" ), 1234.32, .T. }, ; - { "Invoice 2", Date(), 234.98, .F. }, ; - { "Invoice 3", Date() + 1, 0, .T. } } - nErrorCode := 0 - SetColor( "w+/b" ) - cls - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_RESTARR AND FT_SAVEARR" - ? Replicate( "-", 78 ) - ? - ? "Saving array ..." - ? - FT_SAVEARR( aArray, "invoice.dat", @nErrorCode ) - IF nErrorCode == 0 - DispArray( aArray ) - aSave := FT_RESTARR( "invoice.dat", @nErrorCode ) - IF nErrorCode == 0 - ? - ? "Restoring array from disk ..." - ? - DispArray( aSave ) - ELSE - ? "Error restoring array" - ENDIF - ELSE - ? "Error writing array" - ENDIF - RELEASE aArray, aSave, nErrorCode - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // Conversion group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF CONVERSION FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_BYT2BIT() Convert byte to string of 1's and 0's" - ? "FT_BYT2HEX() Convert byte to hexadecimal version of its binary value" - ? "FT_D2E() Convert decimal to scientific notation" - ? "FT_DEC2BIN() Convert decimal to binary" - ? "FT_E2D() Convert scientific notation string to a decimal" - ? "FT_ESCCODE() Convert Lotus style escape codes" - ? "FT_HEX2DEC() Convert a hex number to decimal" - ? "FT_INVCLR() Get the inverse of a color" - ? "FT_NTOW() Translate numeric value to words" - ? "FT_SQZN() Compress a numeric value into a character string" - ? "FT_STOD() Convert a date string to a Clipper date data type" - ? "FT_UNSQZN() Uncompress a numeric compressed by FT_SQZN()" - ? "FT_XTOY() Convert from any data type to any other data type" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_BYT2BIT() example - // - SetColor( "w+/b" ) - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_BYT2BIT()" - ? Replicate( "-", 78 ) - ? - var0 := FT_BYT2BIT( "a" ) - ? PadR( "FT_BYT2BIT( 'a' ) ->", 44 ) + var0 - ? - var0 := FT_BYT2BIT( 'm' ) - ? PadR( "FT_BYT2BIT( 'm' ) ->", 44 ) + var0 - ? - var0 := FT_BYT2BIT( 'A' ) - ? PadR( "FT_BYT2BIT( 'A' ) ->", 44 ) + var0 - ? - var0 := FT_BYT2BIT( 'C' ) - ? PadR( "FT_BYT2BIT( 'C' ) ->", 44 ) + var0 - ? - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_BYT2HEX() example - // - SetColor( "w+/b" ) - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_BYT2HEX()" - ? Replicate( "-", 78 ) - ? - var0 := FT_BYT2HEX( 'a' ) - ? PadR( "FT_BYT2HEX( 'a' ) ->", 44 ) + var0 - ? - var0 := FT_BYT2HEX( 'm' ) - ? PadR( "FT_BYT2HEX( 'm' ) ->", 44 ) + var0 - ? - var0 := FT_BYT2HEX( 'A' ) - ? PadR( "FT_BYT2HEX( 'A' ) ->", 44 ) + var0 - ? - var0 := FT_BYT2HEX( 'C' ) - ? PadR( "FT_BYT2HEX( 'C' ) ->", 44 ) + var0 - ? - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_D2E() example - // - SetColor( "w+/b" ) - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_D2E()" - ? Replicate( "-", 78 ) - ? - var0 := FT_D2E( 12.345, 2 ) - ? PadR( "FT_D2E( 12.345, 2 ) ->", 44 ) + var0 - ? - var0 := FT_D2E( - 12.345, 3 ) - ? PadR( "FT_D2E( -12.345, 3 ) ->", 44 ) + var0 - ? - var0 := FT_D2E( 0.00000543, 2 ) - ? PadR( "FT_D2E( 0.00000543, 2 ) ->", 44 ) + var0 - ? - var0 := FT_D2E( 1010000000, 5 ) - ? PadR( "FT_D2E( 1010000000, 5 ) ->", 44 ) + var0 - ? - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_DEC2BIN() example - // - SetColor( "w+/b" ) - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_DEC2BIN()" - ? Replicate( "-", 78 ) - ? - var0 := FT_DEC2BIN( 255 ) - ? PadR( "FT_DEC2BIN(255) ->", 44 ) + var0 - ? - var0 := FT_DEC2BIN( 105 ) - ? PadR( "FT_DEC2BIN(105) ->", 44 ) + var0 - ? - var0 := FT_DEC2BIN( 1 ) - ? PadR( "FT_DEC2BIN(1) ->", 44 ) + var0 - ? - var0 := FT_DEC2BIN( 15 ) - ? PadR( "FT_DEC2BIN(15) ->", 44 ) + var0 - ? - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_E2D() example - // - SetColor( "w+/b" ) - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_E2D()" - ? Replicate( "-", 78 ) - ? - var0 := FT_E2D( "1.23E1" ) - ? PadR( "FT_E2D( '1.23E1' ) ->", 34 ) + Transform( var0, "9999999999.999999" ) - ? - var0 := FT_E2D( "-1.235E1" ) - ? PadR( "FT_E2D( '-1.235E1' ) ->", 34 ) + Transform( var0, "9999999999.999999" ) - ? - var0 := FT_E2D( "5.43E-6" ) - ? PadR( "FT_E2D( '5.43E-6' ) ->", 34 ) + Transform( var0, "9999999999.99999999" ) - ? - var0 := FT_E2D( "1.101E6" ) - ? PadR( "FT_E2D( '1.101E6' ) ->", 34 ) + Transform( var0, "9999999999.999999" ) - ? - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_STOD() example - // - SetColor( "w+/b" ) - SET CENTURY ON - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_STOD()" - ? Replicate( "-", 78 ) - ? - var0 := FT_STOD( "19901127" ) - ? PadR( "FT_STOD( '19901127' ) ->", 44 ) + Transform( var0, '@d' ) - ? - var0 := FT_STOD( '20060117' ) - ? PadR( "FT_STOD( '20060117' ) ->", 44 ) + Transform( var0, '@d' ) - ? - var0 := FT_STOD( '20060406' ) - ? PadR( "FT_STOD( '20060406' ) ->", 44 ) + Transform( var0, '@d' ) - ? - var0 := FT_STOD( '20041231' ) - ? PadR( "FT_STOD( '20041231' ) ->", 44 ) + Transform( var0, '@d' ) - ? - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // DOS / BIOS group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF DOS/BIOS FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_CHDIR() Change the current directory" - ? "FT_DEFAULT() Retrieve and optionally change the current default drive" - ? "FT_DOSVER Return the current DOS major and minor version as a string" - ? "FT_DSKFREE() Return the amount of available disk space" - ? "FT_DSKSIZE() Return the maximum capacity of a fixed disk" - ? "FT_IAMIDLE() Inform the operating system that the application is idle." - ? "FT_INP() Retrieve a byte from a specified I/O port" - ? "FT_INT86() Execute a software interrupt" - ? "FT_ISPRINT() Check printer status" - ? "FT_ISSHARE() Determine if DOS Share is installed" - ? "FT_MKDIR() Create a subdirectory" - ? "FT_OUTP() Write a byte to a specified I/O port" - ? "FT_PEEK() Retrieve a byte from a specified memory location." - ? "FT_POKE() Write a byte to a specified memory location" - ? "FT_REBOOT() Force a warm or cold boot" - ? "FT_RMDIR() Delete a subdirectory" - ? "FT_SETDATE() Set the DOS system date" - ? "FT_SETTIME() Set the DOS system time" - ? "FT_SYSMEM() Determine the amount of conventional memory installed" - ? "FT_TEMPFIL() Create a file with a unique name" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // DATE / TIME group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF DATE / TIME FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_ACCTADJ() Adjust beginning or ending fiscal pd. dates to acctg. dates" - ? "FT_ACCTMONTH() Return accounting month data" - ? "FT_ACCTQTR() Return accounting quarter data" - ? "FT_ACCTWEEK() Return accounting week data" - ? "FT_ACCTYEAR() Return accounting year data" - ? "FT_ADDWKDY() Return true number of days to add given number of workdays" - ? "FT_CALENDAR() Display date/time calendar, find a date, return calendar data." - ? "FT_CIV2MIL() Convert usual civilian format time to military time." - ? "FT_DATECNFG() Set beginning of year/week for FT_ date functions" - ? "FT_DAYOFYR() Return calendar, fiscal or accounting day data" - ? "FT_DAYTOBOW() Calculate no. of days between date and beginning of week" - ? "FT_DOY() Find number of day within year" - ? "FT_EASTER() Return the date of Easter" - ? "FT_ELAPMIN() Return difference, in minutes, between two mil format times." - ? "FT_ELAPSED() Return elapsed time between two days and/or times" - ? "FT_ELTIME() Compute difference between times in hours, minutes, seconds." - ? "FT_FDAY() Return first day of the month" - ? "FT_LDAY() Return last day of the month" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // DATE / TIME group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF DATE / TIME FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_MADD() Add or subtract months to/from a date" - ? "FT_MIL2CIV() Convert time in military format to civilian format." - ? "FT_MIL2MIN() Convert time in military format to number of minute of day." - ? "FT_MIN2DHM() Convert numeric minutes to days, hours and minutes." - ? "FT_MIN2MIL() Convert minute of day to military format time." - ? "FT_MONTH() Return Calendar or Fiscal Month Data" - ? "FT_QTR() Return Calendar or Fiscal Quarter Data." - ? "FT_SYS2MIL() Convert system time to military time format." - ? "FT_WEEK() Return calendar or fiscal week data" - ? "FT_WORKDAYS() Return number of work days between two dates" - ? "FT_WOY() Find number of week within year" - ? "FT_YEAR() Return calendar or fiscal year data" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_CALENDAR example - // - SetColor( "w+/b" ) - cls - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_CALENDAR" - ? Replicate( "-", 78 ) - ? - KEYBOARD Chr ( 28 ) - aRet := ft_calendar ( 10, 40, 'w+/rb', .T. , .T. ) //display calendar, return all. - cls - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_CALENDAR" - ? Replicate( "-", 78 ) - ? - @ 9, 10 SAY 'FT_CALENDAR return values' - @ 11, 10 SAY 'Date :' + DToC( aRet[1] ) - @ 12, 10 SAY 'Month Number:' + Str( aRet[2], 2, 0 ) - @ 13, 10 SAY 'Day Number :' + Str( aRet[3], 2, 0 ) - @ 14, 10 SAY 'Year Number :' + Str( aRet[4], 4, 0 ) - @ 15, 10 SAY 'Month :' + aRet[5] - @ 16, 10 SAY 'Day :' + aRet[6] - @ 17, 10 SAY 'Julian Day :' + Str( aRet[7], 3, 0 ) - @ 18, 10 SAY 'Current Time:' + aRet[8] - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // ENVIRONMENT group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF ENVIRONMENT FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_GETE() Return the entire current environment" - ? "FT_LINKED() Determine if a function was linked in" - ? "FT_ORIGIN() Report the drive, path and filename of the current program" - ? "FT_RESTSETS() Restore status of all SET command settings" - ? "FT_SAVESETS() Save the status of all the SET command settings" - ? "FT_SETCENTURY() Check/Set the CENTURY Setting" - ? "FT_TREE() Locate all directories and subdirectories on a drive" - ? "FT_WHEREIS() Locate all occurrences of a filespec on a drive" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // EVENT group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF EVENT FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_IDLE() Generate an idle event to allow incremental garbage collection." - ? "FT_ONIDLE() Evaluate a designated code block during idle states." - ? "FT_ONTICK() Evaluate a designated code block at a designated interval." - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FILE I/O group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF FILE I/O FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_DFCLOSE() Close file displayed by FT_DISPFILE()" - ? "FT_DFSETUP() Set up parameters for FT_DISPFILE()" - ? "FT_DISPFILE() Browse a text file" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_DISPFILE example - // - SetColor( "w+/b" ) - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_DISPFILE" - ? Replicate( "-", 78 ) - ? "Press aAbB to terminate." - @ 4, 9 TO 21, 71 - FT_DFSETUP( "libnf.prg", 5, 10, 20, 70, 1, 48, 124, "AaBb" , .F. , 5, 132, 4096 ) - cKey := FT_DISPFILE() - FT_DFCLOSE() - @ 23, 10 SAY "Key that terminated FT_DISPFILE() was: " + '[' + cKey + ']' - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // GAME group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF GAME FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? " FT_PEGS() FT_PEGS GAME (all work and no play...)" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // KEYBOARD / MOUSE group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF KEYBOARD / MOUSE FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_ALT() Determine status of the Alt key" - ? "FT_CAPLOCK() Determine and optionally change the status of CapLock key" - ? "FT_CTRL() Determine status of the Ctrl key" - ? "FT_LASTKEY() Force LastKey() to return a programmer-defined value." - ? "FT_MBUTPRS() Retrieve button press status" - ? "FT_MBUTREL() Get mouse button release information" - ? "FT_MCONOFF() Turn mouse cursur off if in specified region" - ? "FT_MCURSOR() Set the mouse cursor" - ? "FT_MDBLCLK() Return true if a double click was detected" - ? "FT_MDEFCRS() Define the mouse cursor" - ? "FT_MGETCOORD() Get mouse cursor position (text coord.) and button status" - ? "FT_MGETPAGE() Get the display page for the mouse pointer" - ? "FT_MGETPOS() Get mouse cursor position and button status" - ? "FT_MGETSENS() Get the mouse sensitivity parameters" - ? "FT_MGETX() Get mouse cursor row position" - ? "FT_MGETY() Get mouse cursor column position" - ? "FT_MHIDECRS() Decrement internal mouse cursor flag and hide mouse cursor" - ? "FT_MINIT() Initialize the mouse driver, vars and return status of mouse" - ? "FT_MINREGION() Test if the mouse cursor is in the passed region" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // KEYBOARD / MOUSE group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF KEYBOARD / MOUSE FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_MMICKEYS() Get mickeys" - ? "FT_MRESET() Reset mouse driver and return status of mouse" - ? "FT_MSETCOORD() Position the mouse cursor using text screen coordinates" - ? "FT_MSETPAGE() Set the display page for the mouse pointer" - ? "FT_MSETPOS() Position the mouse cursor using virtual screen coordinates" - ? "FT_MSETSENS() Set the mouse sensitivity parameters" - ? "FT_MSHOWCRS() Increment internal cursor flag and display mouse cursor" - ? "FT_MVERSION() Get the mouse driver version" - ? "FT_MXLIMIT() Set vertical bounds of mouse using virtual screen coord." - ? "FT_MYLIMIT() Set horiz. bounds of mouse using virtual screen coordinates" - ? "FT_NUMLOCK() Return status of NumLock key" - ? "FT_PRTSCR() Enable or disable the Print Screen key" - ? "FT_PUTKEY() Stuff a keystroke into the keyboard buffer" - ? "FT_SCANCODE() Wait for keypress and return keyboard scan code" - ? "FT_SETKEYS() Get array of keys redirected via the SetKey() or SET KEY" - ? "FT_SETRATE() Set the keyboard delay and repeat rate on PC/AT & PS/2" - ? "FT_SHIFT() Determine status of shift key" - ? "FT_SINKEY() Replacement for INKEY() that tests for SET KEY procedures" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // MATH group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF MATH FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_GCD() Calculate greatest common divisor of two numbers" - ? "FT_NETPV() Calculate net present value" - ? "FT_RAND1() Generate a random number" - ? "FT_ROUND() Rounds a number to a specific place" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // MENU / PROMPTS group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF MENU / PROMPTS FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_ADDER() Pop up a simple calculator" - ? "FT_BLINK() Display a blinking message on the screen" - ? "FT_BRWSWHL() Browse an indexed database limited to a while condition" - ? "FT_CLRSEL() User Selectable Colour Routine" - ? "FT_DISPMSG() Display a message and optionally waits for a keypress" - ? "FT_FILL() Declare menu options for FT_MENU1()" - ? "FT_MENU1() Pulldown menu system" - ? "FT_MENU2() Vertical lightbar menu" - ? "FT_MENUTO() Execute light bar menu using prompts created with @...PROMPT" - ? "FT_PENDING() Display same-line pending messages after a wait." - ? "FT_PICKDAY() Picklist of days of week" - ? "FT_PROMPT() Define a menu item for use with FT_MenuTo()" - ? "FT_SLEEP Wait for a specified amount of time" - ? "FT_XBOX() Display a self-sizing message box and message" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_ADDER example - // - SetColor( "w+/b" ) - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_ADDER" - ? Replicate( "-", 78 ) - ? - nSickHrs := 0 - nPersHrs := 0 - nVacaHrs := 0 - GetList := {} - SET SCOREBOARD OFF -// _ftSetScrColor( STD_SCREEN, STD_VARIABLE) -// SetColor( "w+/b" ) -// CLS - - SET KEY K_ALT_A TO FT_Adder // Make call FT_Adder - - // SIMPLE Sample of program data entry! - - @ 12, 5 SAY 'Please enter the total Sick, Personal, and Vacation hours.' - @ 15, 22 SAY 'Sick hrs.' - @ 15, 40 SAY 'Pers. hrs.' - @ 15, 60 SAY 'Vaca. hrs.' - @ 23, 20 SAY 'Press to Pop - Up the Adder.' - @ 24, 20 SAY 'Press to Quit the adder Demo.' - DO WHILE .T. // Get the sick, personal, & vaca - @ 16, 24 GET nSickHrs PICTURE '9999.999' // Normally I have a VALID() - @ 16, 43 GET nPersHrs PICTURE '9999.999' // to make sure the value is - @ 16, 63 GET nVacaHrs PICTURE '9999.999' // within the allowable range. - SET CURSOR ON // But, like I said it is a - CLEAR TYPEAHEAD // SIMPLE example . - READ - SET CURSOR OFF - IF LastKey() == K_ESC // - ABORT - CLEAR TYPEAHEAD - EXIT - ENDIF - ENDDO - SET CURSOR ON - SET KEY K_ALT_A // Reset - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // FT_BLINKW32 example - // - SetColor( "w+/b" ) - CLS - ? "TEST TO DEMONSTRATE EXAMPLES OF FT_BLINK AND FT_BLINKW32 / BLINKW32CANCEL" - ? Replicate( "-", 78 ) - ? - ? 'FT_BLINKW32( "[ Hit a key to continue ]", 24, 0, nwait )' - ? 'inkey(0)' - ? 'FT_BLINKW32CANCEL()' - ? - ? "Will produce a blink message as in each of this pages in OS where" - ? "normal hardware blink not operate." - ? "NOTE: this functions are an xHarbour expansion to Nanforum library." - ? - ? 'FT_BLINK( "[ Hit a key to continue ]", 24, 0 )' - ? 'inkey(0)' - ? - ? "Will produce a blink message as in each of this pages in OS where" - ? "normal hardware blink operate." - - FT_BLINK( "[ Hit a key to continue ]", 21, 0 ) - FT_BLINK( "[ Hit a key to continue ]", 22, 10 ) - FT_BLINK( "[ Hit a key to continue ]", 23, 20 ) - FT_BLINK( "[ Hit a key to continue ]", 24, 30 ) - Inkey( 0 ) - - // - // NETWARE group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF NETWARE FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_NWLSTAT() Return the current Novell NetWare logical station number" - ? "FT_NWSEMCLOSE() Close a NetWare semaphore" - ? "FT_NWSEMEX() Examine a NetWare semaphore's value and open count" - ? "FT_NWSEMLOCK() Perform a semaphore lock" - ? "FT_NWSEMOPEN() Open or create a NetWare semaphore" - ? "FT_NWSEMSIG() Signal a NetWare semaphore (increment)" - ? "FT_NWSEMUNLOCK() Unlock a semaphore locked by FT_NWSEMLOCK()" - ? "FT_NWSEMWAIT() Wait on a NetWare semaphore (decrement)" - ? "FT_NWUID() Return the current Novell NetWare User ID" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // STRING group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF STRING FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_AT2() Find position of the nth occurrence of a substring" - ? "FT_BITCLR() Clear (reset) selected bit in a byte" - ? "FT_BITSET() Set selected bit in a byte" - ? "FT_BYTEAND() Perform bit-wise AND on two ASCII characters (bytes)" - ? "FT_BYTENEG() Perform bit-wise negation on an ASCII character" - ? "FT_BYTENOT() Perform bit-wise NOT on an ASCII character (byte)" - ? "FT_BYTEOR() Perform bit-wise OR on two ASCII characters (bytes)" - ? "FT_BYTEXOR() Perform bit-wise XOR on two ASCII characters (bytes)" - ? "FT_FINDITH() Find the ith occurrence of a substring within a string" - ? "FT_ISBIT() Test the status of an individual bit" - ? "FT_ISBITON() Determine the state of individual bits in a number" - ? "FT_METAPH() Convert a character string to MetaPhone format" - ? "FT_NOOCCUR() Find the number of times one string occurs in another" - ? "FT_PCHR() Convert printer control codes" - ? "FT_PROPER() Convert a string to proper-name case" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // VIDEO group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF VIDEO FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_ADAPTER() Report the type of video adapter installed" - ? "FT_CLS() Clear screen" - ? "FT_GETMODE() Get the video mode" - ? "FT_GETVCUR() Return info about the cursor on a specified video page" - ? "FT_GETVPG() Get the currently selected video page" - ? "FT_POPVID() Restore previously saved video states." - ? "FT_PUSHVID() Save current video states on internal stack." - ? "FT_RESTATT() Restore the attribute bytes of a specified screen region." - ? "FT_REVATTR() Reverse colors of specified screen coordinates" - ? "FT_REVCHR() Reverse the color of a single character on the screen" - ? "FT_RGNSTACK() Push or pop a saved screen region on or off the stack" - ? "FT_RSTRGN() Restore region of the screen saved with FT_SAVRGN()" - ? "FT_SAVEATT() Save the attribute bytes of a specified screen region." - ? "FT_SAVRGN() Save a screen region for later display" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - // - // VIDEO group of routines - // - SetColor( "w+/b" ) - CLS - ? "DEMO AND TEST OF VIDEO FUNCTIONS FROM LIBNF" - ? Replicate( "-", 78 ) - ? - ? "FT_SETATTR() Change color attributes of screen region" - ? "FT_SETMODE() Set the video mode" - ? "FT_SETVCUR() Set the cursor position on a specified video page" - ? "FT_SETVPG() Set the current video page" - ? "FT_SHADOW() Draw a non-destructive shadow on the screen" - ? "FT_VIDSTR() Display string on screen in specified attribute" - ? "FT_WRTCHR() Display character on screen" - - FT_BLINK( "[ Hit a key to continue ]", 24, 0 ) - Inkey( 0 ) - - RETURN( NIL ) - -FUNCTION TestGet( b, ar, nDim, nElem ) - - LOCAL GetList := {} - LOCAL nRow := Row() - LOCAL nCol := Col() - LOCAL cSaveScrn := SaveScreen( 21, 0, 22, MaxCol() ) - LOCAL cOldColor := SetColor( "W/N" ) - - @ 21, 0 CLEAR TO 22, MaxCol() - @ 21, 29 SAY "Editing Array Element" - SetColor( cOldColor ) - DO CASE - CASE nDim == 1 - @ nRow, nCol GET ar[1, nElem] PICTURE "99" - READ - b:refreshAll() - CASE nDim == 2 - @ nRow, nCol GET ar[2, nElem] PICTURE "!" - READ - b:refreshAll() - CASE nDim == 3 - @ nRow, nCol GET ar[3, nElem] PICTURE "!" - READ - b:refreshAll() - ENDCASE - RestScreen( 21, 0, 22, MaxCol(), cSaveScrn ) - @ nRow, nCol SAY "" - - RETURN( .T. ) - -FUNCTION DispArray( aTest ) - - LOCAL nk - - FOR nk := 1 TO Len( aTest ) - ? aTest[nk, 1] - ?? ' ' - ?? DToC( aTest[nk, 2] ) - ?? ' ' - ?? Str( aTest[nk, 3] ) - ?? ' ' - ?? iif( aTest[nk, 4], 'true', 'false' ) - NEXT - - RETURN Nil diff --git a/harbour/contrib/hbnf/tests/ntow.prg b/harbour/contrib/hbnf/tests/ntow.prg new file mode 100644 index 0000000000..9f0970f195 --- /dev/null +++ b/harbour/contrib/hbnf/tests/ntow.prg @@ -0,0 +1,10 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cNum ) + + QOut( ft_ntow( Val( cNum ) ) ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/nwlstat.prg b/harbour/contrib/hbnf/tests/nwlstat.prg new file mode 100644 index 0000000000..2b7104ac49 --- /dev/null +++ b/harbour/contrib/hbnf/tests/nwlstat.prg @@ -0,0 +1,10 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + QOut( "Logical station: " + Str( FT_NWLSTAT() ) ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/nwsem.prg b/harbour/contrib/hbnf/tests/nwsem.prg new file mode 100644 index 0000000000..9758fe8ff6 --- /dev/null +++ b/harbour/contrib/hbnf/tests/nwsem.prg @@ -0,0 +1,50 @@ +/* + * $Id$ + */ + +#define INITIAL_SEMAPHORE_VALUE 2 +#define WAIT_SECONDS 1 + +PROCEDURE Main() + + LOCAL nInitVal, nRc, nHandle, nValue, nOpenCnt + + CLS + + nInitVal := INITIAL_SEMAPHORE_VALUE + FT_NWSEMOPEN( "TEST", nInitVal, @nHandle, @nOpenCnt ) + + QOut( "Waiting ten seconds..." ) + nRc := ft_nwSemWait( nHandle, 180 ) + QOut( "Final nRc value = " + Str( nRc ) ) + Inkey( 0 ) + IF nRc == 254 + QOut( "Couldn't get the semaphore. Try again." ) + QUIT + ENDIF + + CLS + + @ 24, 0 SAY "Any key to exit" + @ 0, 0 SAY "Handle: " + Str( nHandle ) + + ft_nwSemEx( nHandle, @nValue, @nOpenCnt ) + WHILE .T. + @ 23, 0 SAY "Semaphore test -> Open at [" + ; + hb_ntos( nOpenCnt ) + ; + "] stations, value is [" + ; + hb_ntos( nValue ) + "]" + + IF Inkey( WAIT_SECONDS ) != 0 + EXIT + ENDIF + + Tone( nHandle, .5 ) + ft_nwSemEx( nHandle, @nValue, @nOpenCnt ) + ENDDO + + QOut( "Signal returns: " + Str( ft_nwsemSig( nHandle ) ) ) + QOut( "Close returns: " + Str( ft_nwsemClose( nHandle ) ) ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/nwuid.prg b/harbour/contrib/hbnf/tests/nwuid.prg new file mode 100644 index 0000000000..e04c495722 --- /dev/null +++ b/harbour/contrib/hbnf/tests/nwuid.prg @@ -0,0 +1,20 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL x, cUid + + QOut( "I am: [" + FT_NWUID() + "]" ) + QOut( "---------------------" ) + + FOR x := 1 TO 100 + cUid := FT_NWUID( x ) + IF ! Empty( cUid ) + QOut( Str( x, 3 ) + Space( 3 ) + cUid ) + ENDIF + NEXT + + RETURN + diff --git a/harbour/contrib/hbnf/tests/pending.prg b/harbour/contrib/hbnf/tests/pending.prg new file mode 100644 index 0000000000..baa9bab373 --- /dev/null +++ b/harbour/contrib/hbnf/tests/pending.prg @@ -0,0 +1,16 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + @ 0, 0 CLEAR + FT_PENDING( "Message one", 20, 0, 3, "W+/G" ) // Displays "Message one." + // sets row to 20, col to 0. + // wait to 3 and color to + // bright white over green. + FT_PENDING( "Message two" ) // Displays "Message two", after 5 sec. + FT_PENDING( "Message three" ) // Displays "Message three", after 5 sec. + + RETURN + diff --git a/harbour/contrib/hbnf/tests/pickday.prg b/harbour/contrib/hbnf/tests/pickday.prg new file mode 100644 index 0000000000..b56567b19f --- /dev/null +++ b/harbour/contrib/hbnf/tests/pickday.prg @@ -0,0 +1,10 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + QOut( "You selected " + FT_PICKDAY() ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/popadder.prg b/harbour/contrib/hbnf/tests/popadder.prg new file mode 100644 index 0000000000..7e876f5925 --- /dev/null +++ b/harbour/contrib/hbnf/tests/popadder.prg @@ -0,0 +1,44 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL nSickHrs := 0 + LOCAL nPersHrs := 0 + LOCAL nVacaHrs := 0 + LOCAL GetList := {} + + SET SCOREBOARD OFF + _ftSetScrColor( STD_SCREEN, STD_VARIABLE ) + CLS + + SET KEY K_ALT_A TO FT_Adder // Make call FT_Adder + + // SIMPLE Sample of program data entry! + + @ 12, 5 SAY "Please enter the total Sick, Personal, and Vacation hours." + @ 15, 22 SAY "Sick hrs." + @ 15, 40 SAY "Pers. hrs." + @ 15, 60 SAY "Vaca. hrs." + @ 23, 20 SAY "Press to Pop - Up the Adder." + @ 24, 20 SAY "Press to Quit the adder Demo." + DO WHILE .T. // Get the sick, personal, & vaca + @ 16, 24 GET nSickHrs PICTURE "9999.999" // Normally I have a VALID() + @ 16, 43 GET nPersHrs PICTURE "9999.999" // to make sure the value is + @ 16, 63 GET nVacaHrs PICTURE "9999.999" // within the allowable range. + SET CURSOR ON // But, like I said it is a + CLEAR TYPEAHEAD // SIMPLE example . + READ + SET CURSOR OFF + IF LastKey() == K_ESC // - ABORT + CLEAR TYPEAHEAD + EXIT + ENDIF + ENDDO + SET CURSOR ON + + SET KEY K_ALT_A // Reset + + RETURN + diff --git a/harbour/contrib/hbnf/tests/prtesc.prg b/harbour/contrib/hbnf/tests/prtesc.prg new file mode 100644 index 0000000000..a38ead1b75 --- /dev/null +++ b/harbour/contrib/hbnf/tests/prtesc.prg @@ -0,0 +1,20 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cParm1 ) + + //------------------------------------------------------- + // Sample routine to test function from command line + //------------------------------------------------------- + + IF PCount() > 0 + ? FT_ESCCODE( cParm1 ) + ELSE + ? "Usage: PRT_ESC 'escape code sequence' " + ? " outputs converted code to standard output" + ? + ENDIF + + RETURN + diff --git a/harbour/contrib/hbnf/tests/rand1.prg b/harbour/contrib/hbnf/tests/rand1.prg new file mode 100644 index 0000000000..3ca011df20 --- /dev/null +++ b/harbour/contrib/hbnf/tests/rand1.prg @@ -0,0 +1,19 @@ +/* + * $Id$ + */ + +// Write 100 random numbers from 1 to 100 to stdout. +// Run it multiple times and redirect output to a file +// to check it + +PROCEDURE Main() + + LOCAL x + + FOR x := 1 TO 100 + OutStd( Int( ft_rand1(100 ) ) ) + OutStd( hb_eol() ) + NEXT + + RETURN + diff --git a/harbour/contrib/hbnf/tests/savearr.prg b/harbour/contrib/hbnf/tests/savearr.prg new file mode 100644 index 0000000000..40463aa58d --- /dev/null +++ b/harbour/contrib/hbnf/tests/savearr.prg @@ -0,0 +1,44 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL aArray := {; + { "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 ) + IF nErrorCode == 0 + CLS + DispArray( aArray ) + aSave := FT_RESTARR( "invoice.dat", @nErrorCode ) + IF nErrorCode == 0 + DispArray( aSave ) + ELSE + ? "Error restoring array" + ENDIF + ELSE + ? "Error writing array" + ENDIF + + RETURN + +FUNCTION DispArray( aTest ) + + LOCAL nk + + FOR nk := 1 TO Len( aTest ) + ? aTest[ nk, 1 ] + ?? " " + ?? DToC( aTest[ nk, 2 ] ) + ?? " " + ?? Str( aTest[ nk, 3 ] ) + ?? " " + ?? iif( aTest[ nk, 4 ], "true", "false" ) + NEXT + + RETURN NIL + diff --git a/harbour/contrib/hbnf/tests/savesets.prg b/harbour/contrib/hbnf/tests/savesets.prg new file mode 100644 index 0000000000..0db64f48d9 --- /dev/null +++ b/harbour/contrib/hbnf/tests/savesets.prg @@ -0,0 +1,14 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL aSets := FT_SAVESETS() + + HB_SYMBOL_UNUSED( aSets ) + + Inkey( 0 ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/scancode.prg b/harbour/contrib/hbnf/tests/scancode.prg new file mode 100644 index 0000000000..854f227c5b --- /dev/null +++ b/harbour/contrib/hbnf/tests/scancode.prg @@ -0,0 +1,23 @@ +/* + * $Id$ + */ + +#define SCANCODE_ESCAPE ( hb_BChar( 27 ) + hb_BChar( 1 ) ) + +PROCEDURE Main() + + LOCAL cKey + + CLS + QOut( "Press any key, ESCape to exit:" ) + + DO WHILE .T. + cKey := FT_SCANCODE() + QOut( Str( hb_BCode( hb_BSubStr( cKey, 1, 1 ) ), 3 ) + ", " + Str( hb_BCode( hb_BSubStr( cKey, 2, 1 ) ), 3 ) + hb_eol() ) + IF cKey == SCANCODE_ESCAPE + EXIT + ENDIF + ENDDO + + RETURN + diff --git a/harbour/contrib/hbnf/tests/setdate.prg b/harbour/contrib/hbnf/tests/setdate.prg new file mode 100644 index 0000000000..9f97f2b24c --- /dev/null +++ b/harbour/contrib/hbnf/tests/setdate.prg @@ -0,0 +1,13 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cDate ) + + cDate := iif( cDate == NIL, DToC( Date() ), cDate ) + QOut( "Setting date to: " + cDate + "... " ) + FT_SETDATE( CToD( cDate ) ) + QOut( "Today is now: " + DToC( Date() ) ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/settime.prg b/harbour/contrib/hbnf/tests/settime.prg new file mode 100644 index 0000000000..4818f5b766 --- /dev/null +++ b/harbour/contrib/hbnf/tests/settime.prg @@ -0,0 +1,13 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cTime ) + + cTime := iif( cTime == NIL, Time(), cTime ) + QOut( "Setting time to: " + cTime + "... " ) + FT_SETTIME( cTime ) + QOut( "Time is now: " + Time() ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/sleep.prg b/harbour/contrib/hbnf/tests/sleep.prg new file mode 100644 index 0000000000..2f3f8e7fd3 --- /dev/null +++ b/harbour/contrib/hbnf/tests/sleep.prg @@ -0,0 +1,15 @@ +/* + * $Id$ + */ + +// Test routine +// Invoke by running SLEEP 1.0 to sleep 1.0 seconds + +PROCEDURE Main( nSleep ) + + ? "Time is now: " + Time() + FT_SLEEP( Val( nSleep ) ) + ? "Time is now: " + Time() + + RETURN + diff --git a/harbour/contrib/hbnf/tests/sysmem.prg b/harbour/contrib/hbnf/tests/sysmem.prg new file mode 100644 index 0000000000..c8f62463b6 --- /dev/null +++ b/harbour/contrib/hbnf/tests/sysmem.prg @@ -0,0 +1,10 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + QOut( "Conventional memory: " + Str( FT_SYSMEM() ) + "K installed" ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/tbwhile.prg b/harbour/contrib/hbnf/tests/tbwhile.prg new file mode 100644 index 0000000000..6440578ebb --- /dev/null +++ b/harbour/contrib/hbnf/tests/tbwhile.prg @@ -0,0 +1,107 @@ +/* + * $Id$ + */ + +/* + * THIS DEMO SHOWS tbnames.dbf CONSISTING OF LAST, FIRST, ADDR, CITY, + * STATE, ZIP WITH ACTIVE INDEX ON LAST + FIRST. IT SHOWS LAST NAME, + * FIRST NAME, CITY ONLY FOR THOSE LAST NAMES THAT BEGIN WITH LETTER + * THAT YOU INPUT FOR THE CKEY GET. + * + * tbnames.dbf/.ntx ARE AUTOMATICALLY CREATED BY THIS TEST PROGRAM + */ + +PROCEDURE Main() + + LOCAL aFields := {}, cKey := "O", cOldColor + LOCAL nFreeze := 1, lSaveScrn := .T. , nRecSel + LOCAL cColorList := "N/W, N/BG, B/W, B/BG, B/W, B/BG, R/W, B/R" + LOCAL cColorShad := "N/N" + FIELD last, first + MEMVAR GetList + + IF ! hb_FileExists( "tbnames.dbf" ) + MAKE_DBF() + ENDIF + + USE TBNames + + IF ! hb_FileExists( "tbnames.ntx" ) + INDEX ON last + first TO TBNAMES + ENDIF + + SET INDEX TO TBNAMES + + // Pass Heading as character and Field as Block including Alias + // To eliminate the need to use FIELDWBLOCK() function in FT_BRWSWHL() + + AAdd( aFields, { "Last Name" , {|| TBNames->Last } } ) + AAdd( aFields, { "First Name", {|| TBNames->First } } ) + AAdd( aFields, { "City" , {|| TBNames->City } } ) + + cOldColor := SetColor( "N/BG" ) + CLS + @ 5, 10 SAY "Enter First Letter Of Last Name:" GET cKey PICTURE "!" + READ + + // TBNames->Last = cKey is the Conditional Block passed to this function + // you can make it as complicated as you want, but you would then + // have to modify TBWhileSet() to find first and last records + // matching your key. + nRecSel := FT_BRWSWHL( aFields, {|| TBNames->Last = cKey }, cKey, nFreeze, ; + lSaveScrn, cColorList, cColorShad, 3, 6, MaxRow() - 2, MaxCol() - 6 ) + // Note you can use Compound Condition + // such as cLast =: "Pierce " and cFirst =: "Hawkeye " + // by changing above block to: + // {|| TBNames->Last = cLast .AND. TBNames->First = cFirst } + // and setting cKey := cLast + cFirst + + ? + IF nRecSel == 0 + ? "Sorry, NO Records Were Selected" + ELSE + ? "You Selected " + TBNames->Last + " " + ; + TBNames->First + " " + TBNames->City + ENDIF + ? + + WAIT + SetColor( cOldColor ) + CLS + + RETURN + +STATIC FUNCTION make_dbf() + + LOCAL x, aData := { ; + { "SHAEFER", "KATHRYN", "415 WEST CITRUS ROAD #150", "LOS ANGELES", "CA", "90030" }, ; + { "OLSON", "JAMES", "225 NORTH RANCH ROAD", "LOS ANGELES", "CA", "90023" }, ; + { "KAYBEE", "JOHN", "123 SANDS ROAD", "CAMARILLO", "CA", "93010" }, ; + { "HERMAN", "JIM", "123 TOON PAGE ROAD", "VENTURA", "CA", "93001" }, ; + { "BURNS", "FRANK", "123 VIRGINA STREET", "OXNARD", "CA", "93030" }, ; + { "PIERCE", "HAWKEYE", "123 OLD TOWN ROAD", "PORT MUGU", "CA", "93043" }, ; + { "MORGAN", "JESSICA", "123 FRONTAGE ROAD", "CAMARILLO", "CA", "93010" }, ; + { "POTTER", "ROBERT", "123 FIR STREET", "OXNARD", "CA", "93030" }, ; + { "WORTH", "MARY", "123-1/2 JOHNSON DRIVE", "OXNARD", "CA", "93033" }, ; + { "JOHNSON", "SUSAN", "123 QUEENS STREET", "OXNARD", "CA", "93030" }, ; + { "SAMSON", "SAM", "215 MAIN STREET", "OXNARD", "CA", "93030" }, ; + { "NEWNAME", "JAMES", "215 MAIN STREET", "LOS ANGELES", "CA", "90000" }, ; + { "OLEANDAR", "JILL", "425 FLORAL PARK DRIVE", "FLORAL PARK", "NY", "10093" }, ; + { "SUGARMAN", "CANDY", "1541 SWEETHEART ROAD", "HERSHEY", "PA", "10132" } } + + dbCreate( "TBNAMES", {; + { "LAST ", "C", 18, 0, } , ; + { "FIRST", "C", 9, 0, } , ; + { "ADDR ", "C", 28, 0, } , ; + { "CITY ", "C", 21, 0, } , ; + { "STATE", "C", 2, 0, } , ; + { "ZIP ", "C", 9, 0, } } ) + USE tbnames + FOR x := 1 TO Len( aData ) + APPEND BLANK + AEval( aData[ x ], {| e, n | FieldPut( n, e ) } ) + NEXT + USE + + RETURN NIL + diff --git a/harbour/contrib/hbnf/tests/tempfile.prg b/harbour/contrib/hbnf/tests/tempfile.prg new file mode 100644 index 0000000000..71b6668714 --- /dev/null +++ b/harbour/contrib/hbnf/tests/tempfile.prg @@ -0,0 +1,21 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cPath, cHide ) + + LOCAL cFile, nHandle + + cFile := FT_TEMPFIL( cPath, ( cHide == "Y" ) ) + + IF ! Empty( cFile ) + QOut( cFile ) + nHandle := FOpen( cFile, FO_WRITE ) + FWrite( nHandle, "This is a test!" ) + FClose( nHandle ) + ELSE + QOut( "An error occurred" ) + ENDIF + + RETURN + diff --git a/harbour/contrib/hbnf/tests/vertmenu.prg b/harbour/contrib/hbnf/tests/vertmenu.prg new file mode 100644 index 0000000000..081f3f70d4 --- /dev/null +++ b/harbour/contrib/hbnf/tests/vertmenu.prg @@ -0,0 +1,50 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + 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() } }, ; + { "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 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" } } + + FT_MENU2( mainmenu ) + + RETURN + +/* stub functions to avoid missing symbols */ + +STATIC PROCEDURE cust() ; RETURN +STATIC PROCEDURE inv() ; RETURN +STATIC PROCEDURE vendors() ; RETURN +STATIC PROCEDURE custrep() ; RETURN +STATIC PROCEDURE pastdue() ; RETURN +STATIC PROCEDURE weeksales() ; RETURN +STATIC PROCEDURE monthpl() ; RETURN +STATIC PROCEDURE vendorrep() ; RETURN +STATIC PROCEDURE re_ntx() ; RETURN +STATIC PROCEDURE backup() ; RETURN +STATIC PROCEDURE compress() ; RETURN + diff --git a/harbour/contrib/hbnf/tests/vidmode.prg b/harbour/contrib/hbnf/tests/vidmode.prg new file mode 100644 index 0000000000..c025678b39 --- /dev/null +++ b/harbour/contrib/hbnf/tests/vidmode.prg @@ -0,0 +1,11 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cMode ) + + FT_SETMODE( Val( cMode ) ) + QOut( "Video mode is: " + Str( FT_GETMODE() ) ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/wda.prg b/harbour/contrib/hbnf/tests/wda.prg new file mode 100644 index 0000000000..df49aeaf19 --- /dev/null +++ b/harbour/contrib/hbnf/tests/wda.prg @@ -0,0 +1,13 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cDate, cDays ) + + LOCAL nDays := ft_addWkDy( CToD( cDate ), Val( cDays ) ) + + QOut( "Num days to add: " + Str( nDays ) ) + QOut( "New date: " + DToC( CToD( cDate ) + nDays ) ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/workdays.prg b/harbour/contrib/hbnf/tests/workdays.prg new file mode 100644 index 0000000000..ad540fe894 --- /dev/null +++ b/harbour/contrib/hbnf/tests/workdays.prg @@ -0,0 +1,10 @@ +/* + * $Id$ + */ + +PROCEDURE Main( cStart, cStop ) + + QOut( ft_workdays( CToD( cStart ), CToD( cStop ) ) ) + + RETURN + diff --git a/harbour/contrib/hbnf/tests/woy.prg b/harbour/contrib/hbnf/tests/woy.prg new file mode 100644 index 0000000000..b36b0f0661 --- /dev/null +++ b/harbour/contrib/hbnf/tests/woy.prg @@ -0,0 +1,51 @@ +/* + * $Id$ + */ + +// ADD PARAMETER "CENTURY" ON COMMAND LINES TO TEST 4-DIGIT YEARS + +PROCEDURE Main( cCent ) + + LOCAL lCentOn := .F. , cDate + MEMVAR getlist + + IF HB_ISSTRING( cCent ) .AND. "CENT" $ Upper( cCent ) + SET CENTURY ON + lCentOn := .T. + ENDIF + + DO WHILE .T. + CLEAR + @ 2, 10 SAY "Date to Test" + + IF lCentOn + cDate := Space( 10 ) + @ 2, 24 GET cDate PICTURE "##/##/####" + ELSE + cDate := Space( 8 ) + @ 2, 24 GET cDate PICTURE "##/##/##" + ENDIF + READ + + IF Empty( cDate ) + EXIT + ENDIF + + IF Left( DToC( CToD( cDate ) ), 1 ) == " " + Tone( 800, 1 ) + @ 4, 24 SAY "INVALID DATE" + Inkey( 2 ) + LOOP + ENDIF + + @ 4, 10 SAY "Is Day Number " + Str( FT_DOY( CToD( cDate ) ), 3 ) + + @ 6, 10 SAY "Is in Week Number " + Str( FT_WOY( CToD( cDate ) ), 2 ) + @ 7, 0 + WAIT + ENDDO + + CLEAR + + RETURN + diff --git a/harbour/contrib/hbnf/tests/xbox.prg b/harbour/contrib/hbnf/tests/xbox.prg new file mode 100644 index 0000000000..d50ea9fdaa --- /dev/null +++ b/harbour/contrib/hbnf/tests/xbox.prg @@ -0,0 +1,25 @@ +/* + * $Id$ + */ + +PROCEDURE Main() + + LOCAL i + + SetColor( "W/B" ) +// CLS + FOR i := 1 TO 24 + @ i, 0 SAY Replicate( "@", 80 ) + NEXT + + FT_XBOX( , , , , , , , "This is a test", "of the XBOX() function" ) + FT_XBOX( "L", "W", "D", "GR+/R", "W/B", 1, 10, "It is so nice", ; + "to not have to do the messy chore", ; + "of calculating the box size!" ) + FT_XBOX( , "W", "D", "GR+/R", "W/B", 16, 10, "It is so nice", ; + "to not have to do the messy chore", ; + "of calculating the box size!", ; + "Even though this line is way too long, and is in fact more than 80 characters long, if you care to check!" ) + + RETURN + diff --git a/harbour/contrib/hbnf/vertmenu.prg b/harbour/contrib/hbnf/vertmenu.prg index 234fdfcbab..cb2c0ca28b 100644 --- a/harbour/contrib/hbnf/vertmenu.prg +++ b/harbour/contrib/hbnf/vertmenu.prg @@ -20,56 +20,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main() - - 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() } }, ; - { "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 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" } } - - FT_MENU2( mainmenu ) - - RETURN - -/* stub functions to avoid missing symbols */ - -STATIC PROCEDURE cust() ; RETURN -STATIC PROCEDURE inv() ; RETURN -STATIC PROCEDURE vendors() ; RETURN -STATIC PROCEDURE custrep() ; RETURN -STATIC PROCEDURE pastdue() ; RETURN -STATIC PROCEDURE weeksales() ; RETURN -STATIC PROCEDURE monthpl() ; RETURN -STATIC PROCEDURE vendorrep() ; RETURN -STATIC PROCEDURE re_ntx() ; RETURN -STATIC PROCEDURE backup() ; RETURN -STATIC PROCEDURE compress() ; RETURN - -#endif - /* FT_MENU2(): display vertical menu */ diff --git a/harbour/contrib/hbnf/vidmode.prg b/harbour/contrib/hbnf/vidmode.prg index 1741b8ef6d..049527bbfa 100644 --- a/harbour/contrib/hbnf/vidmode.prg +++ b/harbour/contrib/hbnf/vidmode.prg @@ -32,17 +32,6 @@ #define VIDEO 16 #define GETMODE 15 -#ifdef FT_TEST - -PROCEDURE Main( cMode ) - - FT_SETMODE( Val( cMode ) ) - QOut( "Video mode is: " + Str( FT_GETMODE() ) ) - - RETURN - -#endif - FUNCTION FT_SETMODE( nMode ) /* LOCAL aRegs[ INT86_MAX_REGS ] diff --git a/harbour/contrib/hbnf/wda.prg b/harbour/contrib/hbnf/wda.prg index 7d83923632..27ffeaabc0 100644 --- a/harbour/contrib/hbnf/wda.prg +++ b/harbour/contrib/hbnf/wda.prg @@ -20,19 +20,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main( cDate, cDays ) - - LOCAL nDays := ft_addWkDy( CToD( cDate ), Val( cDays ) ) - - QOut( "Num days to add: " + Str( nDays ) ) - QOut( "New date: " + DToC( CToD( cDate ) + nDays ) ) - - RETURN - -#endif - FUNCTION ft_addWkDy( dStart, nDys ) LOCAL nDc := DOW( dStart ) diff --git a/harbour/contrib/hbnf/workdays.prg b/harbour/contrib/hbnf/workdays.prg index 957d8b1d9e..97ecc3f503 100644 --- a/harbour/contrib/hbnf/workdays.prg +++ b/harbour/contrib/hbnf/workdays.prg @@ -26,16 +26,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main( cStart, cStop ) - - QOut( ft_workdays( CToD( cStart ), CToD( cStop ) ) ) - - RETURN - -#endif - FUNCTION FT_WorkDays( dStart, dStop ) LOCAL nWorkDays := 0, nDays, nAdjust diff --git a/harbour/contrib/hbnf/woy.prg b/harbour/contrib/hbnf/woy.prg index 6ce45dc13b..edcbb879c7 100644 --- a/harbour/contrib/hbnf/woy.prg +++ b/harbour/contrib/hbnf/woy.prg @@ -24,57 +24,6 @@ * */ -#ifdef FT_TEST - -// ADD PARAMETER "CENTURY" ON COMMAND LINES TO TEST 4-DIGIT YEARS - -PROCEDURE Main( cCent ) - - LOCAL lCentOn := .F. , cDate - MEMVAR getlist - - IF HB_ISSTRING( cCent ) .AND. "CENT" $ Upper( cCent ) - SET CENTURY ON - lCentOn := .T. - ENDIF - - DO WHILE .T. - CLEAR - @ 2, 10 SAY "Date to Test" - - IF lCentOn - cDate := Space( 10 ) - @ 2, 24 GET cDate PICTURE "##/##/####" - ELSE - cDate := Space( 8 ) - @ 2, 24 GET cDate PICTURE "##/##/##" - ENDIF - READ - - IF Empty( cDate ) - EXIT - ENDIF - - IF Left( DToC( CToD( cDate ) ), 1 ) == " " - Tone( 800, 1 ) - @ 4, 24 SAY "INVALID DATE" - Inkey( 2 ) - LOOP - ENDIF - - @ 4, 10 SAY "Is Day Number " + Str( FT_DOY( CToD( cDate ) ), 3 ) - - @ 6, 10 SAY "Is in Week Number " + Str( FT_WOY( CToD( cDate ) ), 2 ) - @ 7, 0 - WAIT - ENDDO - - CLEAR - - RETURN - -#endif - FUNCTION FT_WOY( dInDate ) LOCAL nFirstDays, nDayOffset, nWkNumber, cCentury diff --git a/harbour/contrib/hbnf/xbox.prg b/harbour/contrib/hbnf/xbox.prg index 17006d94c7..7f19bc6d51 100644 --- a/harbour/contrib/hbnf/xbox.prg +++ b/harbour/contrib/hbnf/xbox.prg @@ -26,31 +26,6 @@ * */ -#ifdef FT_TEST - -PROCEDURE Main() - - LOCAL i - - SetColor( "W/B" ) -// clear screen - FOR i := 1 TO 24 - @ i, 0 SAY Replicate( "@", 80 ) - NEXT - - FT_XBOX( , , , , , , , "This is a test", "of the XBOX() function" ) - FT_XBOX( "L", "W", "D", "GR+/R", "W/B", 1, 10, "It is so nice", ; - "to not have to do the messy chore", ; - "of calculating the box size!" ) - FT_XBOX( , "W", "D", "GR+/R", "W/B", 16, 10, "It is so nice", ; - "to not have to do the messy chore", ; - "of calculating the box size!", ; - "Even though this line is way too long, and is in fact more than 80 characters long, if you care to check!" ) - - RETURN - -#endif - /* NOTE: In original NF, flag parameters were also accepted when having extra characters (f.e. "DOUBLE" instead of "D"), but only if _SET_EXACT was set to .F., Harbour accepts them