diff --git a/harbour/ChangeLog b/harbour/ChangeLog index f7c3348bd2..d9e18c2928 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,10 @@ The license applies to all entries newer than 2009-04-28. */ +2012-10-18 11:31 UTC+0200 Viktor Szakats (harbour syenar.net) + * contrib/hbnf/*.prg + * cleanups, minor opts + 2012-10-18 02:19 UTC+0200 Viktor Szakats (harbour syenar.net) * src/rtl/gtdos/gtdos.c * TOFIX added about duplicate macros with same functionality diff --git a/harbour/contrib/hbnf/acctadj.prg b/harbour/contrib/hbnf/acctadj.prg index 8ab89b37b0..7b80a83e17 100644 --- a/harbour/contrib/hbnf/acctadj.prg +++ b/harbour/contrib/hbnf/acctadj.prg @@ -42,7 +42,7 @@ FUNCTION FT_ACCTADJ( dGivenDate, lIsEnd ) nTemp := FT_DAYTOBOW( dGivenDate ) IF nTemp > ( 2 + iif( lIsEnd, 0, 1 ) ) - dGivenDate += ( 7 - nTemp ) // Next Week Start (This Week End + 1) + dGivenDate += 7 - nTemp // Next Week Start (This Week End + 1) ELSE dGivenDate -= nTemp // This Week Start (Prior Week End + 1) ENDIF diff --git a/harbour/contrib/hbnf/amedian.prg b/harbour/contrib/hbnf/amedian.prg index 53d20d3288..a0a548c732 100644 --- a/harbour/contrib/hbnf/amedian.prg +++ b/harbour/contrib/hbnf/amedian.prg @@ -47,7 +47,7 @@ FUNCTION FT_AMEDIAN( aArray, nStart, nEnd ) // Determine middle value(s) IF ( nTemplen % 2 ) == 0 - nMiddle1 := aTemparray[ ( nTemplen / 2 ) ] + nMiddle1 := aTemparray[ nTemplen / 2 ] nMiddle2 := aTemparray[ Int( nTemplen / 2 ) + 1 ] nMedian := Int( ( nMIddle1 + nMiddle2 ) / 2 ) ELSE diff --git a/harbour/contrib/hbnf/clrsel.prg b/harbour/contrib/hbnf/clrsel.prg index 9754fa0f23..196e5e94bf 100644 --- a/harbour/contrib/hbnf/clrsel.prg +++ b/harbour/contrib/hbnf/clrsel.prg @@ -47,12 +47,8 @@ * Thanks to Brian Loesgen for offering ideas and helping to tweak * the code. * - * */ -//------------------------------------------------ -// Pre-processor stuff - #include "setcurs.ch" #include "inkey.ch" @@ -70,25 +66,6 @@ #translate BkGrnd( , , , , ) =>; hb_DispBox( , , , , Replicate( , 9 ) ) -//------------------------------------------------ -// Demo of FT_ClrSel() - -/* - * To run the sample program: - * - * Compile : Clipper ClrSel /n /m /w /dFT_TEST - * Link : Rtlink FILE ClrSel LIB NanFor [/PLL:Fullbase] - * .OR. [/PLL:Base50] - * - * ClrSel MONO To force monochrome mode - * ClrSel NOSNOW To prevent CGA snowstorms - * ClrSel EGA 43 line mode - * ClrSel VGA 50 line mode - * - */ - -//------------------------------------------------ - FUNCTION FT_ClrSel( aClrs, lColour, cChr ) // Colour selection routine @@ -115,7 +92,7 @@ FUNCTION FT_ClrSel( aClrs, lColour, cChr ) SetCursor( SC_NONE ) SetColor( iif( lColour, "GR+/N,,N/N", "W+/N,,N/N" ) ) - CLS + hb_Scroll() //.... initialize the colour palette aClrPal := _ftInitPal( iif( lColour, aClrTab, aClrBW ) ) @@ -167,7 +144,7 @@ FUNCTION FT_ClrSel( aClrs, lColour, cChr ) RETURN iif( nChoice == 1, aClrs, aClrOld ) -//------------------------------------------------ +// // Highlight the current selected aChoice element // Return -> NIL @@ -180,7 +157,7 @@ STATIC FUNCTION _ftHiLite( nRow, nCol, cStr, nLen ) RETURN NIL -//------------------------------------------------ +// // Colour selection for specific type of colour setting // Return -> aOpt with modified colour strings @@ -292,7 +269,7 @@ STATIC FUNCTION _ftColours( aOpt, aClrPal, lColour ) RETURN aOpt -//------------------------------------------------ +// // Show an example of the colour setting // Return -> NIL @@ -404,7 +381,7 @@ STATIC FUNCTION _ftShowIt( aOpt ) RETURN NIL -//------------------------------------------------ +// // select the colour combination from aClrPal and place in cClr // cClr is the current colour being modified @@ -482,7 +459,7 @@ STATIC FUNCTION _ftClrSel( aClrPal, cClr, nElem, aOpt ) RETURN cClr -//------------------------------------------------ +// // Place a colour setting in the colour string // Return -> modified colour string @@ -495,7 +472,7 @@ STATIC FUNCTION _ftClrPut( cClrStr, nElem, cClr ) RETURN _ftArr2Chr( aClr ) -//------------------------------------------------ +// // Select the character to be used for the desktop background // Return -> same array with new character @@ -550,7 +527,7 @@ STATIC FUNCTION _ftDeskChar( aOpt ) RETURN aOpt -//------------------------------------------------ +// // Convert a chr string to an array // Return -> array @@ -575,7 +552,7 @@ STATIC FUNCTION _ftChr2Arr( cString, cDelim ) RETURN aArray -//------------------------------------------------ +// // convert an array to a chr string // Return -> string @@ -591,7 +568,7 @@ STATIC FUNCTION _ftArr2Chr( aArray, cDelim ) RETURN cString -//------------------------------------------------ +// // Paint the palette on the screen // Return -> NIL @@ -617,7 +594,7 @@ STATIC FUNCTION _ftShowPal( aClrPal, cChr ) RETURN NIL -//------------------------------------------------ +// // Initialise the colour palette based on the passed colour table aClrTab // Load the palette with colours @@ -639,7 +616,7 @@ STATIC FUNCTION _ftInitPal( aClrTab ) RETURN aClrPal -//------------------------------------------------ +// // Compares the contents of 2 arrays // Return -> logical diff --git a/harbour/contrib/hbnf/dectobin.prg b/harbour/contrib/hbnf/dectobin.prg index 4179ef821f..ca13ac44c3 100644 --- a/harbour/contrib/hbnf/dectobin.prg +++ b/harbour/contrib/hbnf/dectobin.prg @@ -25,7 +25,8 @@ FUNCTION FT_DEC2BIN( x ) - LOCAL i, buffer := { "0", "0", "0", "0", "0", "0", "0", "0" } + LOCAL buffer := { "0", "0", "0", "0", "0", "0", "0", "0" } + LOCAL i FOR i := 8 TO 1 STEP -1 IF x >= 2 ^ ( i - 1 ) @@ -34,5 +35,6 @@ FUNCTION FT_DEC2BIN( x ) ENDIF NEXT - RETURN buffer[ 1 ] + buffer[ 2 ] + buffer[ 3 ] + buffer[ 4 ] + ; + RETURN ; + buffer[ 1 ] + buffer[ 2 ] + buffer[ 3 ] + buffer[ 4 ] + ; buffer[ 5 ] + buffer[ 6 ] + buffer[ 7 ] + buffer[ 8 ] diff --git a/harbour/contrib/hbnf/diskfunc.prg b/harbour/contrib/hbnf/diskfunc.prg index e54df2d613..2b27593702 100644 --- a/harbour/contrib/hbnf/diskfunc.prg +++ b/harbour/contrib/hbnf/diskfunc.prg @@ -28,7 +28,9 @@ #include "fileio.ch" FUNCTION FT_DSKSIZE( cDrive ) + RETURN hb_DiskSpace( cDrive + hb_osDriveSeparator(), HB_DISK_TOTAL ) FUNCTION FT_DSKFREE( cDrive ) + RETURN hb_DiskSpace( cDrive + hb_osDriveSeparator(), HB_DISK_FREE ) diff --git a/harbour/contrib/hbnf/e2d.prg b/harbour/contrib/hbnf/e2d.prg index 0b555acedb..6b34fcc623 100644 --- a/harbour/contrib/hbnf/e2d.prg +++ b/harbour/contrib/hbnf/e2d.prg @@ -25,13 +25,10 @@ FUNCTION ft_e2d( sNumE ) - LOCAL nMant, nExp - - nMant := Val( Left( sNumE, At( "E", sNumE ) - 1 ) ) - nExp := Val( SubStr( sNumE, ; + LOCAL nMant := Val( Left( sNumE, At( "E", sNumE ) - 1 ) ) + LOCAL nExp := Val( SubStr( sNumE, ; At( "E", sNumE ) + 1, ; Len( sNumE ) - At( "E", sNumE ) ; - ) ; - ) + ) ) RETURN nMant * 10 ^ nExp diff --git a/harbour/contrib/hbnf/eltime.prg b/harbour/contrib/hbnf/eltime.prg index 9ad274a761..7257675987 100644 --- a/harbour/contrib/hbnf/eltime.prg +++ b/harbour/contrib/hbnf/eltime.prg @@ -28,9 +28,9 @@ FUNCTION FT_ELTIME( cTIME1, cTIME2 ) LOCAL nDELSECS, nHRS, nMINS, nSECS, nSECS1, nSECS2 nSECS1 := ( Val( SubStr( cTIME1, 1, 2 ) ) * 3600 ) + ; - ( Val( SubStr( cTIME1, 4, 2 ) ) * 60 ) + ( Val( SubStr( cTIME1, 7 ) ) ) + ( Val( SubStr( cTIME1, 4, 2 ) ) * 60 ) + Val( SubStr( cTIME1, 7 ) ) nSECS2 := ( Val( SubStr( cTIME2, 1, 2 ) ) * 3600 ) + ; - ( Val( SubStr( cTIME2, 4, 2 ) ) * 60 ) + ( Val( SubStr( cTIME2, 7 ) ) ) + ( Val( SubStr( cTIME2, 4, 2 ) ) * 60 ) + Val( SubStr( cTIME2, 7 ) ) nDELSECS := Abs( nSECS2 - nSECS1 ) nHRS := Int( nDELSECS / 3600 ) nMINS := Int( ( nDELSECS - nHRS * 3600 ) / 60 ) diff --git a/harbour/contrib/hbnf/menuto.prg b/harbour/contrib/hbnf/menuto.prg index cae90af884..251dcb936c 100644 --- a/harbour/contrib/hbnf/menuto.prg +++ b/harbour/contrib/hbnf/menuto.prg @@ -78,7 +78,6 @@ FUNCTION FT_Prompt( nRow, nCol, cPrompt, cColor, ; nUp, nDown, nLeft, nRight, bExecute ) // If the prompt color setting is not specified, use default - IF cColor == NIL cColor := SetColor() ENDIF @@ -92,13 +91,11 @@ FUNCTION FT_Prompt( nRow, nCol, cPrompt, cColor, ; ELSE // If message row not supplied, use the default - IF nMsgRow == NIL nMsgRow := Set( _SET_MESSAGE ) ENDIF // If message column not supplied, use the default - IF nMsgCol == NIL IF Set( _SET_MCENTER ) nMsgCol := Int( ( MaxCol() + 1 - Len( cPrompt ) ) / 2 ) @@ -108,14 +105,12 @@ FUNCTION FT_Prompt( nRow, nCol, cPrompt, cColor, ; ENDIF // If message color not specified, use the default - IF cMsgColor == NIL cMsgColor := cColor ENDIF ENDIF // If trigger values not specifed, set the defaults - IF nTrigger == NIL nTrigger := 1 ENDIF @@ -125,7 +120,6 @@ FUNCTION FT_Prompt( nRow, nCol, cPrompt, cColor, ; // Now add elements to the static arrays -- t_nLevel indicates the recursion // level, which allows for nested menus. - AAdd( t_aRow[ t_nLevel ], nRow ) AAdd( t_aCol[ t_nLevel ], nCol ) AAdd( t_aPrompt[ t_nLevel ], cPrompt ) @@ -146,7 +140,6 @@ FUNCTION FT_Prompt( nRow, nCol, cPrompt, cColor, ; AAdd( t_aExecute[ t_nLevel ], bExecute ) // Now display the prompt for the sake of compatibility - DispBegin() hb_DispOutAt( nRow, nCol, cPrompt, cColor ) hb_DispOutAt( nRow, nCol - 1 + nTrigger, cTrigger, cTriggerColor ) @@ -252,17 +245,14 @@ FUNCTION FT_MenuTo( bGetSet, cReadVar, lCold ) DispEnd() // Wait for a keystroke - nKey := Inkey( 0 ) // If the key was an alphabetic char, convert to uppercase - IF isBetween( nKey, 97, 122 ) nKey -= 32 ENDIF // Set nPrev to the currently active menu item - nPrev := nActive DO CASE diff --git a/harbour/contrib/hbnf/metaph.prg b/harbour/contrib/hbnf/metaph.prg index 4f479dce0f..3572357d6c 100644 --- a/harbour/contrib/hbnf/metaph.prg +++ b/harbour/contrib/hbnf/metaph.prg @@ -91,11 +91,7 @@ * */ -//------------------------------------------------ - -FUNCTION FT_METAPH( cName, nSize ) - - // Calculates the metaphone of a character string +FUNCTION FT_METAPH( cName, nSize ) // Calculates the metaphone of a character string LOCAL cMeta @@ -109,23 +105,23 @@ FUNCTION FT_METAPH( cName, nSize ) cMeta := " " + _ftMakeAlpha( Upper( AllTrim( cName ) ) ) + " " // prefixes which need special consideration - IF " KN" $ cMeta ; cMeta := StrTran( cMeta, " KN" , " N" ) ; ENDIF - IF " GN" $ cMeta ; cMeta := StrTran( cMeta, " GN" , " N" ) ; ENDIF - IF " PN" $ cMeta ; cMeta := StrTran( cMeta, " PN" , " N" ) ; ENDIF - IF " AE" $ cMeta ; cMeta := StrTran( cMeta, " AE" , " E" ) ; ENDIF - IF " X" $ cMeta ; cMeta := StrTran( cMeta, " X" , " S" ) ; ENDIF - IF " WR" $ cMeta ; cMeta := StrTran( cMeta, " WR" , " R" ) ; ENDIF - IF " WHO" $ cMeta ; cMeta := StrTran( cMeta, " WHO", " H" ) ; ENDIF - IF " WH" $ cMeta ; cMeta := StrTran( cMeta, " WH" , " W" ) ; ENDIF - IF " MCG" $ cMeta ; cMeta := StrTran( cMeta, " MCG", " MK" ) ; ENDIF - IF " MC" $ cMeta ; cMeta := StrTran( cMeta, " MC" , " MK" ) ; ENDIF - IF " MACG" $ cMeta ; cMeta := StrTran( cMeta, " MACG", " MK" ) ; ENDIF - IF " MAC" $ cMeta ; cMeta := StrTran( cMeta, " MAC", " MK" ) ; ENDIF - IF " GI" $ cMeta ; cMeta := StrTran( cMeta, " GI", " K" ) ; ENDIF + IF " KN" $ cMeta ; cMeta := StrTran( cMeta, " KN" , " N" ) ; ENDIF + IF " GN" $ cMeta ; cMeta := StrTran( cMeta, " GN" , " N" ) ; ENDIF + IF " PN" $ cMeta ; cMeta := StrTran( cMeta, " PN" , " N" ) ; ENDIF + IF " AE" $ cMeta ; cMeta := StrTran( cMeta, " AE" , " E" ) ; ENDIF + IF " X" $ cMeta ; cMeta := StrTran( cMeta, " X" , " S" ) ; ENDIF + IF " WR" $ cMeta ; cMeta := StrTran( cMeta, " WR" , " R" ) ; ENDIF + IF " WHO" $ cMeta ; cMeta := StrTran( cMeta, " WHO", " H" ) ; ENDIF + IF " WH" $ cMeta ; cMeta := StrTran( cMeta, " WH" , " W" ) ; ENDIF + IF " MCG" $ cMeta ; cMeta := StrTran( cMeta, " MCG", " MK" ) ; ENDIF + IF " MC" $ cMeta ; cMeta := StrTran( cMeta, " MC" , " MK" ) ; ENDIF + IF " MACG" $ cMeta ; cMeta := StrTran( cMeta, " MACG", " MK" ) ; ENDIF + IF " MAC" $ cMeta ; cMeta := StrTran( cMeta, " MAC", " MK" ) ; ENDIF + IF " GI" $ cMeta ; cMeta := StrTran( cMeta, " GI", " K" ) ; ENDIF // Suffixes which need special consideration - IF "MB " $ cMeta ; cMeta := StrTran( cMeta, "MB " , "M " ) ; ENDIF - IF "NG " $ cMeta ; cMeta := StrTran( cMeta, "NG " , "N " ) ; ENDIF + IF "MB " $ cMeta ; cMeta := StrTran( cMeta, "MB " , "M " ) ; ENDIF + IF "NG " $ cMeta ; cMeta := StrTran( cMeta, "NG " , "N " ) ; ENDIF // Remove inner spaces (1st and last byte are spaces) IF " " $ SubStr( cMeta, 2, Len( cMeta ) - 2 ) @@ -133,58 +129,58 @@ FUNCTION FT_METAPH( cName, nSize ) ENDIF // Double consonants sound much the same as singles - IF "BB" $ cMeta ; cMeta := StrTran( cMeta, "BB" , "B" ) ; ENDIF - IF "CC" $ cMeta ; cMeta := StrTran( cMeta, "CC" , "CH" ) ; ENDIF - IF "DD" $ cMeta ; cMeta := StrTran( cMeta, "DD" , "T" ) ; ENDIF - IF "FF" $ cMeta ; cMeta := StrTran( cMeta, "FF" , "F" ) ; ENDIF - IF "GG" $ cMeta ; cMeta := StrTran( cMeta, "GG" , "K" ) ; ENDIF - IF "KK" $ cMeta ; cMeta := StrTran( cMeta, "KK" , "K" ) ; ENDIF - IF "LL" $ cMeta ; cMeta := StrTran( cMeta, "LL" , "L" ) ; ENDIF - IF "MM" $ cMeta ; cMeta := StrTran( cMeta, "MM" , "M" ) ; ENDIF - IF "NN" $ cMeta ; cMeta := StrTran( cMeta, "NN" , "N" ) ; ENDIF - IF "PP" $ cMeta ; cMeta := StrTran( cMeta, "PP" , "P" ) ; ENDIF - IF "RR" $ cMeta ; cMeta := StrTran( cMeta, "RR" , "R" ) ; ENDIF - IF "SS" $ cMeta ; cMeta := StrTran( cMeta, "SS" , "S" ) ; ENDIF - IF "TT" $ cMeta ; cMeta := StrTran( cMeta, "TT" , "T" ) ; ENDIF - IF "XX" $ cMeta ; cMeta := StrTran( cMeta, "XX" , "KS" ) ; ENDIF - IF "ZZ" $ cMeta ; cMeta := StrTran( cMeta, "ZZ" , "S" ) ; ENDIF + IF "BB" $ cMeta ; cMeta := StrTran( cMeta, "BB" , "B" ) ; ENDIF + IF "CC" $ cMeta ; cMeta := StrTran( cMeta, "CC" , "CH" ) ; ENDIF + IF "DD" $ cMeta ; cMeta := StrTran( cMeta, "DD" , "T" ) ; ENDIF + IF "FF" $ cMeta ; cMeta := StrTran( cMeta, "FF" , "F" ) ; ENDIF + IF "GG" $ cMeta ; cMeta := StrTran( cMeta, "GG" , "K" ) ; ENDIF + IF "KK" $ cMeta ; cMeta := StrTran( cMeta, "KK" , "K" ) ; ENDIF + IF "LL" $ cMeta ; cMeta := StrTran( cMeta, "LL" , "L" ) ; ENDIF + IF "MM" $ cMeta ; cMeta := StrTran( cMeta, "MM" , "M" ) ; ENDIF + IF "NN" $ cMeta ; cMeta := StrTran( cMeta, "NN" , "N" ) ; ENDIF + IF "PP" $ cMeta ; cMeta := StrTran( cMeta, "PP" , "P" ) ; ENDIF + IF "RR" $ cMeta ; cMeta := StrTran( cMeta, "RR" , "R" ) ; ENDIF + IF "SS" $ cMeta ; cMeta := StrTran( cMeta, "SS" , "S" ) ; ENDIF + IF "TT" $ cMeta ; cMeta := StrTran( cMeta, "TT" , "T" ) ; ENDIF + IF "XX" $ cMeta ; cMeta := StrTran( cMeta, "XX" , "KS" ) ; ENDIF + IF "ZZ" $ cMeta ; cMeta := StrTran( cMeta, "ZZ" , "S" ) ; ENDIF // J sounds - IF "DGE" $ cMeta ; cMeta := StrTran( cMeta, "DGE" , "J" ) ; ENDIF - IF "DGY" $ cMeta ; cMeta := StrTran( cMeta, "DGY" , "J" ) ; ENDIF - IF "DGI" $ cMeta ; cMeta := StrTran( cMeta, "DGI" , "J" ) ; ENDIF - IF "GI" $ cMeta ; cMeta := StrTran( cMeta, "GI" , "J" ) ; ENDIF - IF "GE" $ cMeta ; cMeta := StrTran( cMeta, "GE" , "J" ) ; ENDIF - IF "GY" $ cMeta ; cMeta := StrTran( cMeta, "GY" , "J" ) ; ENDIF + IF "DGE" $ cMeta ; cMeta := StrTran( cMeta, "DGE" , "J" ) ; ENDIF + IF "DGY" $ cMeta ; cMeta := StrTran( cMeta, "DGY" , "J" ) ; ENDIF + IF "DGI" $ cMeta ; cMeta := StrTran( cMeta, "DGI" , "J" ) ; ENDIF + IF "GI" $ cMeta ; cMeta := StrTran( cMeta, "GI" , "J" ) ; ENDIF + IF "GE" $ cMeta ; cMeta := StrTran( cMeta, "GE" , "J" ) ; ENDIF + IF "GY" $ cMeta ; cMeta := StrTran( cMeta, "GY" , "J" ) ; ENDIF // X sounds (KS) - IF "X" $ cMeta ; cMeta := StrTran( cMeta, "X" , "KS" ) ; ENDIF + IF "X" $ cMeta ; cMeta := StrTran( cMeta, "X" , "KS" ) ; ENDIF // special consideration for SCH - IF "ISCH" $ cMeta; cMeta := StrTran( cMeta, "ISCH", "IX" ) ; ENDIF - IF "SCH" $ cMeta ; cMeta := StrTran( cMeta, "SCH" , "SK" ) ; ENDIF + IF "ISCH" $ cMeta; cMeta := StrTran( cMeta, "ISCH", "IX" ) ; ENDIF + IF "SCH" $ cMeta ; cMeta := StrTran( cMeta, "SCH" , "SK" ) ; ENDIF // sh sounds (X) - IF "CIA" $ cMeta ; cMeta := StrTran( cMeta, "CIA" , "X" ) ; ENDIF - IF "SIO" $ cMeta ; cMeta := StrTran( cMeta, "SIO" , "X" ) ; ENDIF - IF "C" $ cMeta ; cMeta := StrTran( cMeta, "SIA" , "X" ) ; ENDIF - IF "SH" $ cMeta ; cMeta := StrTran( cMeta, "SH" , "X" ) ; ENDIF - IF "TIA" $ cMeta ; cMeta := StrTran( cMeta, "TIA" , "X" ) ; ENDIF - IF "TIO" $ cMeta ; cMeta := StrTran( cMeta, "TIO" , "X" ) ; ENDIF - IF "TCH" $ cMeta ; cMeta := StrTran( cMeta, "TCH" , "X" ) ; ENDIF - IF "CH" $ cMeta ; cMeta := StrTran( cMeta, "CH" , "X" ) ; ENDIF + IF "CIA" $ cMeta ; cMeta := StrTran( cMeta, "CIA" , "X" ) ; ENDIF + IF "SIO" $ cMeta ; cMeta := StrTran( cMeta, "SIO" , "X" ) ; ENDIF + IF "C" $ cMeta ; cMeta := StrTran( cMeta, "SIA" , "X" ) ; ENDIF + IF "SH" $ cMeta ; cMeta := StrTran( cMeta, "SH" , "X" ) ; ENDIF + IF "TIA" $ cMeta ; cMeta := StrTran( cMeta, "TIA" , "X" ) ; ENDIF + IF "TIO" $ cMeta ; cMeta := StrTran( cMeta, "TIO" , "X" ) ; ENDIF + IF "TCH" $ cMeta ; cMeta := StrTran( cMeta, "TCH" , "X" ) ; ENDIF + IF "CH" $ cMeta ; cMeta := StrTran( cMeta, "CH" , "X" ) ; ENDIF // hissing sounds (S) - IF "SCI" $ cMeta ; cMeta := StrTran( cMeta, "SCI" , "S" ) ; ENDIF - IF "SCE" $ cMeta ; cMeta := StrTran( cMeta, "SCE" , "S" ) ; ENDIF - IF "SCY" $ cMeta ; cMeta := StrTran( cMeta, "SCY" , "S" ) ; ENDIF - IF "CI" $ cMeta ; cMeta := StrTran( cMeta, "CI" , "S" ) ; ENDIF - IF "CE" $ cMeta ; cMeta := StrTran( cMeta, "CE" , "S" ) ; ENDIF - IF "CY" $ cMeta ; cMeta := StrTran( cMeta, "CY" , "S" ) ; ENDIF - IF "Z" $ cMeta ; cMeta := StrTran( cMeta, "Z" , "S" ) ; ENDIF + IF "SCI" $ cMeta ; cMeta := StrTran( cMeta, "SCI" , "S" ) ; ENDIF + IF "SCE" $ cMeta ; cMeta := StrTran( cMeta, "SCE" , "S" ) ; ENDIF + IF "SCY" $ cMeta ; cMeta := StrTran( cMeta, "SCY" , "S" ) ; ENDIF + IF "CI" $ cMeta ; cMeta := StrTran( cMeta, "CI" , "S" ) ; ENDIF + IF "CE" $ cMeta ; cMeta := StrTran( cMeta, "CE" , "S" ) ; ENDIF + IF "CY" $ cMeta ; cMeta := StrTran( cMeta, "CY" , "S" ) ; ENDIF + IF "Z" $ cMeta ; cMeta := StrTran( cMeta, "Z" , "S" ) ; ENDIF // th sound (0) - IF "TH" $ cMeta ; cMeta := StrTran( cMeta, "TH" , "0" ) ; ENDIF + IF "TH" $ cMeta ; cMeta := StrTran( cMeta, "TH" , "0" ) ; ENDIF // Convert all vowels to 'v' from 3rd byte on cMeta := Left( cMeta, 2 ) + _ftConvVowel( SubStr( cMeta, 3 ) ) @@ -197,62 +193,58 @@ FUNCTION FT_METAPH( cName, nSize ) ENDIF // More G sounds, looking at surrounding vowels - IF "GHv" $ cMeta ; cMeta := StrTran( cMeta, "GHv" , "G" ) ; ENDIF - IF "vGHT" $ cMeta; cMeta := StrTran( cMeta, "vGHT", "T" ) ; ENDIF - IF "vGH" $ cMeta ; cMeta := StrTran( cMeta, "vGH" , "W" ) ; ENDIF - IF "GN" $ cMeta ; cMeta := StrTran( cMeta, "GN" , "N" ) ; ENDIF - IF "G" $ cMeta ; cMeta := StrTran( cMeta, "G" , "K" ) ; ENDIF + IF "GHv" $ cMeta ; cMeta := StrTran( cMeta, "GHv" , "G" ) ; ENDIF + IF "vGHT" $ cMeta; cMeta := StrTran( cMeta, "vGHT", "T" ) ; ENDIF + IF "vGH" $ cMeta ; cMeta := StrTran( cMeta, "vGH" , "W" ) ; ENDIF + IF "GN" $ cMeta ; cMeta := StrTran( cMeta, "GN" , "N" ) ; ENDIF + IF "G" $ cMeta ; cMeta := StrTran( cMeta, "G" , "K" ) ; ENDIF // H sounds, looking at surrounding vowels - IF "vHv" $ cMeta ; cMeta := StrTran( cMeta, "vHv" , "H" ) ; ENDIF - IF "vH" $ cMeta ; cMeta := StrTran( cMeta, "vH" , "" ) ; ENDIF + IF "vHv" $ cMeta ; cMeta := StrTran( cMeta, "vHv" , "H" ) ; ENDIF + IF "vH" $ cMeta ; cMeta := StrTran( cMeta, "vH" , "" ) ; ENDIF // F sounds - IF "PH" $ cMeta ; cMeta := StrTran( cMeta, "PH" , "F" ) ; ENDIF - IF "V" $ cMeta ; cMeta := StrTran( cMeta, "V" , "F" ) ; ENDIF + IF "PH" $ cMeta ; cMeta := StrTran( cMeta, "PH" , "F" ) ; ENDIF + IF "V" $ cMeta ; cMeta := StrTran( cMeta, "V" , "F" ) ; ENDIF // D sounds a bit like T - IF "D" $ cMeta ; cMeta := StrTran( cMeta, "D" , "T" ) ; ENDIF + IF "D" $ cMeta ; cMeta := StrTran( cMeta, "D" , "T" ) ; ENDIF // K sounds - IF "CK" $ cMeta ; cMeta := StrTran( cMeta, "CK" , "K" ) ; ENDIF - IF "Q" $ cMeta ; cMeta := StrTran( cMeta, "Q" , "K" ) ; ENDIF - IF "C" $ cMeta ; cMeta := StrTran( cMeta, "C" , "K" ) ; ENDIF + IF "CK" $ cMeta ; cMeta := StrTran( cMeta, "CK" , "K" ) ; ENDIF + IF "Q" $ cMeta ; cMeta := StrTran( cMeta, "Q" , "K" ) ; ENDIF + IF "C" $ cMeta ; cMeta := StrTran( cMeta, "C" , "K" ) ; ENDIF // Remove vowels cMeta := StrTran( cMeta, "v" ) RETURN PadR( AllTrim( cMeta ), nSize ) -//------------------------------------------------ +// -STATIC FUNCTION _ftMakeAlpha( cStr ) - - // Strips non-alpha characters from a string, leaving spaces +STATIC FUNCTION _ftMakeAlpha( cStr ) // Strips non-alpha characters from a string, leaving spaces LOCAL x, cAlpha := "" FOR x := 1 TO Len( cStr ) IF SubStr( cStr, x, 1 ) == " " .OR. IsAlpha( SubStr( cStr, x, 1 ) ) - cAlpha := cAlpha + SubStr( cStr, x, 1 ) + cAlpha += SubStr( cStr, x, 1 ) ENDIF NEXT RETURN cAlpha -//------------------------------------------------ +// -STATIC FUNCTION _ftConvVowel( cStr ) - - // Converts all vowels to letter 'v' +STATIC FUNCTION _ftConvVowel( cStr ) // Converts all vowels to letter 'v' LOCAL x, cConverted := "" FOR x := 1 TO Len( cStr ) IF SubStr( cStr, x, 1 ) $ "AEIOU" - cConverted := cConverted + "v" + cConverted += "v" ELSE - cConverted := cConverted + SubStr( cStr, x, 1 ) + cConverted += SubStr( cStr, x, 1 ) ENDIF NEXT diff --git a/harbour/contrib/hbnf/mouse1.prg b/harbour/contrib/hbnf/mouse1.prg index 25e859a209..5850eea469 100644 --- a/harbour/contrib/hbnf/mouse1.prg +++ b/harbour/contrib/hbnf/mouse1.prg @@ -85,8 +85,7 @@ FUNCTION FT_MDBLCLK( nClick, nButton, nInterval, nRow, nCol, nStart ) ENDDO // make sure we haven't moved - - lDouble := lDouble .AND. ( nVert == nRow .AND. nHorz == nCol ) + lDouble := lDouble .AND. nVert == nRow .AND. nHorz == nCol ENDIF @@ -129,7 +128,6 @@ FUNCTION FT_MINIT() t_lMinit := ( FT_MRESET() != 0 ) ELSE // Reset maximum x and y limits - FT_MYLIMIT( 0, 8 * 24 ) FT_MXLIMIT( 0, 8 * 80 ) ENDIF @@ -140,14 +138,14 @@ FUNCTION FT_MRESET() LOCAL lStatus - t_lCrsState := .F. // Cursor is off after reset + t_lCrsState := .F. // Cursor is off after reset lStatus := _m_reset() - // Reset maximum x and y limits + // Reset maximum x and y limits FT_MYLIMIT( 0, 8 * MaxRow() ) FT_MXLIMIT( 0, 8 * MaxCol() ) - RETURN lStatus // return status code + RETURN lStatus // return status code FUNCTION FT_MCURSOR( lState ) @@ -169,12 +167,12 @@ FUNCTION FT_MSHOWCRS() t_lCrsState := .T. - RETURN NIL // no output from function + RETURN NIL // no output from function -FUNCTION FT_MHIDECRS() // decrement internal cursor flag and hide cursor +FUNCTION FT_MHIDECRS() // decrement internal cursor flag and hide cursor _mse_mhidecrs() t_lCrsState := .F. - RETURN NIL // no output from function + RETURN NIL // no output from function diff --git a/harbour/contrib/hbnf/nooccur.prg b/harbour/contrib/hbnf/nooccur.prg index 450860ca0e..d3c79b50a7 100644 --- a/harbour/contrib/hbnf/nooccur.prg +++ b/harbour/contrib/hbnf/nooccur.prg @@ -25,7 +25,7 @@ FUNCTION FT_NOOCCUR( cCheckFor, cCheckIn, lIgnoreCase ) - // Is Case Important?? + // Is Case Important? IF ! HB_ISLOGICAL( lIgnoreCase ) .OR. lIgnoreCase cCheckFor := Upper( cCheckFor ) cCheckIn := Upper( cCheckIn ) diff --git a/harbour/contrib/hbnf/ntow.prg b/harbour/contrib/hbnf/ntow.prg index 144f77d937..e372a79de4 100644 --- a/harbour/contrib/hbnf/ntow.prg +++ b/harbour/contrib/hbnf/ntow.prg @@ -20,17 +20,20 @@ * */ -STATIC sc_ones := { "", " One", " Two", " Three", " Four", " Five", ; +STATIC sc_ones := { ; + "", " One", " Two", " Three", " Four", " Five", ; " Six", " Seven", " Eight", " Nine" ; } -STATIC sc_teens := { " Ten", " Eleven", " Twelve", ; +STATIC sc_teens := { ; + " Ten", " Eleven", " Twelve", ; " Thirteen", " Fourteen", " Fifteen", ; " Sixteen", " Seventeen", " Eighteen", ; " Nineteen" ; } -STATIC sc_tens := { "", "", " Twenty", " Thirty", " Forty", " Fifty", ; +STATIC sc_tens := { ; + "", "", " Twenty", " Thirty", " Forty", " Fifty", ; " Sixty", " Seventy", " Eighty", " Ninety" } STATIC sc_qualifiers := { "", " Thousand", " Million", " Billion", " Trillion" } diff --git a/harbour/contrib/hbnf/nwsem.prg b/harbour/contrib/hbnf/nwsem.prg index 470a8b1e6c..9711ba71a9 100644 --- a/harbour/contrib/hbnf/nwsem.prg +++ b/harbour/contrib/hbnf/nwsem.prg @@ -32,9 +32,8 @@ * */ -// -------------------------------------------------------------- -// Semaphore Package for Novell NetWare -// -------------------------------------------------------------- +// Semaphore Package for Novell NetWare +// ------------------------------------ #include "ftint86.ch" @@ -102,9 +101,8 @@ FUNCTION ft_nwSemClose( nHandle ) RETURN _ftnwsem( CLOSE_SEMAPHORE, nHandle ) -// --------------------------------------------------------- +// ----------------------------------------------- // _ftnwsem() - internal for the semaphore package -// --------------------------------------------------------- /* TODO: rewrite in C */ STATIC FUNCTION _ftnwsem( nOp, nHandle, nTimeout ) diff --git a/harbour/contrib/hbnf/nwuid.prg b/harbour/contrib/hbnf/nwuid.prg index 46e53caa86..562161b545 100644 --- a/harbour/contrib/hbnf/nwuid.prg +++ b/harbour/contrib/hbnf/nwuid.prg @@ -33,6 +33,7 @@ #include "ftint86.ch" +/* TODO: rewrite in C */ FUNCTION FT_NWUID( nConn ) LOCAL aRegs[ INT86_MAX_REGS ] diff --git a/harbour/contrib/hbnf/pegs.prg b/harbour/contrib/hbnf/pegs.prg index 14bc5f94a4..7a0b2366a9 100644 --- a/harbour/contrib/hbnf/pegs.prg +++ b/harbour/contrib/hbnf/pegs.prg @@ -90,7 +90,7 @@ FUNCTION FT_PEGS() */ scanblock := {| a | a[ 2 ] == move2 } - CLS + hb_Scroll() SetColor( "w/r" ) hb_DispBox( 22, 31, 24, 48, hb_UTF8ToStrBox( "┌─┐│┘─└│ " ) ) hb_DispOutAt( 23, 33, "Your move:" ) @@ -163,7 +163,7 @@ FUNCTION FT_PEGS() RETURN NIL -//--------------------------------------------------------------------* +// STATIC FUNCTION DrawBox( board_, nelement ) @@ -179,7 +179,7 @@ STATIC FUNCTION DrawBox( board_, nelement ) RETURN NIL -//--------------------------------------------------------------------* +// STATIC FUNCTION err_msg( msg ) @@ -194,7 +194,7 @@ STATIC FUNCTION err_msg( msg ) RETURN NIL -//--------------------------------------------------------------------* +// STATIC FUNCTION moremoves( board_ ) diff --git a/harbour/contrib/hbnf/popadder.prg b/harbour/contrib/hbnf/popadder.prg index 6cfe2c3fdf..ded76add8c 100644 --- a/harbour/contrib/hbnf/popadder.prg +++ b/harbour/contrib/hbnf/popadder.prg @@ -3,7 +3,7 @@ */ /* - * Author....: Keith A. Wire + * Author....: Keith A. Wire (docs included) * CIS ID....: 73760,2427 * * This is an original work by Keith A. Wire and is placed in the @@ -112,22 +112,12 @@ THREAD STATIC t_nWinColor THREAD STATIC t_aWinColor THREAD STATIC t_aStdColor -/*+- Function ---------------------------------------------------------------+ - | Name: FT_Adder() Docs: Keith A. Wire | - | Description: Pop Up Adder / Calculator with Tape Display | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 11:18:40am Time updated: 11:18:40am | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: None | - | Return Value: NIL | - | Notes: To make FT_Adder() pop up from any wait state in your | - | : application just insert the line: | - | : SET KEY K_ALT_A TO FT_Adder | - | : at the top of your application | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Pop Up Adder / Calculator with Tape Display +// NOTE: To make FT_Adder() pop up from any wait state in your +// application just insert the line: +// SET KEY K_ALT_A TO FT_Adder +// at the top of your application FUNCTION FT_Adder() @@ -303,18 +293,8 @@ FUNCTION FT_Adder() RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftAddScreen() Docs: Keith A. Wire | - | Description: Display the Adder | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 11:24:29am Time updated: 11:24:29am | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: aAdder | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Display the Adder STATIC FUNCTION _ftAddScreen( aAdder ) @@ -365,19 +345,8 @@ STATIC FUNCTION _ftAddScreen( aAdder ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftChangeDec() Docs: Keith A. Wire | - | Description: Change the decimal position in the display | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 11:25:17am Time updated: 11:25:17am | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: aAdder | - | : nNumDec | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Change the decimal position in the display STATIC FUNCTION _ftChangeDec( aAdder, nNumDec ) @@ -406,18 +375,8 @@ STATIC FUNCTION _ftChangeDec( aAdder, nNumDec ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftDispTotal() Docs: Keith A. Wire | - | Description: Display total number to Adder Window | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 11:25:58am Time updated: 11:25:58am | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: aAdder | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Display total number to Adder Window STATIC FUNCTION _ftDispTotal( aAdder ) @@ -440,18 +399,8 @@ STATIC FUNCTION _ftDispTotal( aAdder ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftDispSubTot() Docs: Keith A. Wire | - | Description: Display subtotal number | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 11:26:31am Time updated: 11:26:31am | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: aAdder | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Display subtotal number STATIC FUNCTION _ftDispSubTot( aAdder ) @@ -474,19 +423,8 @@ STATIC FUNCTION _ftDispSubTot( aAdder ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftProcessNumb() Docs: Keith A. Wire | - | Description: Act on NUMBER key pressed | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 11:38:34am Time updated: 11:38:34am | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: aAdder | - | : nKey | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Act on NUMBER key pressed STATIC FUNCTION _ftProcessNumb( aAdder, nKey ) @@ -520,18 +458,8 @@ STATIC FUNCTION _ftProcessNumb( aAdder, nKey ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftAddTotal() Docs: Keith A. Wire | - | Description: Enter key - SUBTOTAL\TOTAL | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:05:29pm Time updated: 12:05:29pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: aAdder | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Enter key - SUBTOTAL\TOTAL STATIC FUNCTION _ftAddTotal( aAdder ) @@ -605,19 +533,8 @@ STATIC FUNCTION _ftAddTotal( aAdder ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftAddSub() Docs: Keith A. Wire | - | Description: Process + or - keypress | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:06:13pm Time updated: 12:06:13pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: aAdder | - | : nKey | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Process + or - keypress STATIC FUNCTION _ftAddSub( aAdder, nKey ) @@ -659,19 +576,8 @@ STATIC FUNCTION _ftAddSub( aAdder, nKey ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftMultDiv() Docs: Keith A. Wire | - | Description: Process * or / keypress | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:06:43pm Time updated: 12:06:43pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: aAdder | - | : nKey | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Process * or / keypress STATIC FUNCTION _ftMultDiv( aAdder, nKey ) @@ -718,18 +624,8 @@ STATIC FUNCTION _ftMultDiv( aAdder, nKey ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftAddHelp Docs: Keith A. Wire | - | Description: Help window | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:07:07pm Time updated: 12:07:07pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: None | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Help window STATIC FUNCTION _ftAddHelp @@ -756,18 +652,8 @@ STATIC FUNCTION _ftAddHelp RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftClearAdder() Docs: Keith A. Wire | - | Description: Clear entry / Clear Adder | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:07:33pm Time updated: 12:07:33pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: aAdder | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Clear entry / Clear Adder STATIC FUNCTION _ftClearAdder( aAdder ) @@ -788,20 +674,8 @@ STATIC FUNCTION _ftClearAdder( aAdder ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftUpdateTrans() Docs: Keith A. Wire | - | Description: Update transactions array | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:07:55pm Time updated: 12:07:55pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: aAdder | - | : lTypeTotal | - | : nAmount | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Update transactions array STATIC FUNCTION _ftUpdateTrans( aAdder, lTypeTotal, nAmount ) @@ -836,18 +710,8 @@ STATIC FUNCTION _ftUpdateTrans( aAdder, lTypeTotal, nAmount ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftEraseTotSubTot() Docs: Keith A. Wire | - | Description: Clear the & from Adder | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:08:14pm Time updated: 12:08:14pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: aAdder | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Clear the & from Adder STATIC FUNCTION _ftEraseTotSubTot( aAdder ) @@ -857,18 +721,8 @@ STATIC FUNCTION _ftEraseTotSubTot( aAdder ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftRoundIt() Docs: Keith A. Wire | - | Description: Adder Rounding function | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:09:00pm Time updated: 12:09:00pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: nNumber | - | : nPlaces | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Adder Rounding function STATIC FUNCTION _ftRoundIt( nNumber, nPlaces ) @@ -877,19 +731,8 @@ STATIC FUNCTION _ftRoundIt( nNumber, nPlaces ) RETURN iif( nNumber < 0.0, -1.0, 1.0 ) * ; Int( Abs( nNumber ) * 10 ^ nPlaces + 0.50 + 10 ^ -12 ) / 10 ^ nPlaces -/*+- Function ---------------------------------------------------------------+ - | Name: _ftDivide() Docs: Keith A. Wire | - | Description: Check divide by zero not allowed | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:10:41pm Time updated: 12:10:41pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: aAdder | - | : nNumerator | - | : nDenominator | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Check divide by zero not allowed STATIC FUNCTION _ftDivide( aAdder, nNumerator, nDenominator ) @@ -902,17 +745,8 @@ STATIC FUNCTION _ftDivide( aAdder, nNumerator, nDenominator ) RETURN nNumerator / nDenominator -/*+- Function ---------------------------------------------------------------+ - | Name: _ftValDeci() Docs: Keith A. Wire | - | Description: Validate the number of decimals | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:10:56pm Time updated: 12:10:56pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: oGet | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Validate the number of decimals STATIC FUNCTION _ftValDeci( oGet ) @@ -925,19 +759,8 @@ STATIC FUNCTION _ftValDeci( oGet ) RETURN lRtnValue -/*+- Function ---------------------------------------------------------------+ - | Name: _ftDisplayTape() Docs: Keith A. Wire | - | Description: Display the Tape | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:11:28pm Time updated: 12:11:28pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: aAdder | - | : nKey | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Display the Tape STATIC FUNCTION _ftDisplayTape( aAdder, nKey ) @@ -975,20 +798,10 @@ STATIC FUNCTION _ftDisplayTape( aAdder, nKey ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftSetLastKey() Docs: Keith A. Wire | - | Description: Sets the LASTKEY() value to value of nLastKey | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:12:00pm Time updated: 12:12:00pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: nLastKey | - | Return Value: NIL | - | Notes: I use this in most of my Pop-Up routines to reset the | - | : original value of LASTKEY() when quitting. | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Sets the LASTKEY() value to value of nLastKey +// NOTE: I use this in most of my Pop-Up routines to reset the +// original value of LASTKEY() when quitting. STATIC FUNCTION _ftSetLastKey( nLastKey ) @@ -999,21 +812,11 @@ STATIC FUNCTION _ftSetLastKey( nLastKey ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftPushKeys Docs: Keith A. Wire | - | Description: Push any keys in the Keyboard buffer on the array t_aKeys[]| - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:16:09pm Time updated: 12:16:09pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: None | - | Return Value: NIL | - | Notes: Save any keys in the buffer... for FAST typists . | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Push any keys in the Keyboard buffer on the array t_aKeys[] +// NOTE: Save any keys in the buffer... for FAST typists . -STATIC FUNCTION _ftPushKeys +STATIC FUNCTION _ftPushKeys() DO WHILE NextKey() != 0 AAdd( t_aKeys, Inkey() ) @@ -1021,19 +824,8 @@ STATIC FUNCTION _ftPushKeys RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftPopKeys Docs: Keith A. Wire | - | Description: Restore the keyboard with any keystrokes that were saved | - | : with _ftPushKeys | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:17:58pm Time updated: 12:17:58pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: None | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Restore the keyboard with any keystrokes that were saved with _ftPushKeys STATIC FUNCTION _ftPopKeys @@ -1044,24 +836,9 @@ STATIC FUNCTION _ftPopKeys RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftPushMessage() Docs: Keith A. Wire | - | Description: Display a message on the screen in a window | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:18:53pm Time updated: 12:18:53pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: cMessage | - | : lWait | - | : cTitle | - | : cBotTitle | - | : xQuiet | - | : nTop | - | Return Value: NIL | - | See Also: _ftPopMessage | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Display a message on the screen in a window +// See Also: _ftPopMessage STATIC FUNCTION _ftPushMessage( cMessage, lWait, cTitle, cBotTitle, xQuiet, nTop ) @@ -1108,19 +885,9 @@ STATIC FUNCTION _ftPushMessage( cMessage, lWait, cTitle, cBotTitle, xQuiet, nTop RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftPopMessage Docs: Keith A. Wire | - | Description: Pop off the Message Box | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:24:22pm Time updated: 12:24:22pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: None | - | Return Value: NIL | - | See Also: _ftPushMessage() | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Pop off the Message Box +// See Also: _ftPushMessage() STATIC FUNCTION _ftPopMessage @@ -1128,25 +895,9 @@ STATIC FUNCTION _ftPopMessage RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftQuest() Docs: Keith A. Wire | - | Description: Push a Question Box on the Screen | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:25:32pm Time updated: 12:25:32pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: cMessage | - | : xVarVal | - | : cPict | - | : bValid | - | : lNoESC | - | : nWinColor | - | : nTop | - | Return Value: xVarVal | - | Notes: This function will work for all Data Types | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Push a Question Box on the Screen +// NOTE: This function will work for all Data Types STATIC FUNCTION _ftQuest( cMessage, xVarVal, cPict, bValid, lNoESC, nWinColor, nTop ) @@ -1236,20 +987,8 @@ STATIC FUNCTION _ftQuest( cMessage, xVarVal, cPict, bValid, lNoESC, nWinColor, n RETURN xVarVal -/*+- Function ---------------------------------------------------------------+ - | Name: _ftAdderTapeUDF() Docs: Keith A. Wire | - | Description: User function for ACHOICE() when scrolling tape | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:26:44pm Time updated: 12:26:44pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: mode | - | : cur_elem | - | : rel_pos | - | Return Value: nRtnVal | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// User function for ACHOICE() when scrolling tape STATIC FUNCTION _ftAdderTapeUDF( mode, cur_elem, rel_pos, /* @ */ lAC_exit_ok ) @@ -1280,19 +1019,8 @@ STATIC FUNCTION _ftAdderTapeUDF( mode, cur_elem, rel_pos, /* @ */ lAC_exit_ok ) RETURN nRtnVal -/*+- Function ---------------------------------------------------------------+ - | Name: _ftError() Docs: Keith A. Wire | - | Description: Display an ERROR message in a window | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:27:43pm Time updated: 12:27:43pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: cMessage | - | : xDontReset | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Display an ERROR message in a window STATIC FUNCTION _ftError( cMessage, xDontReset ) @@ -1339,19 +1067,8 @@ STATIC FUNCTION _ftError( cMessage, xDontReset ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftStuffComma() Docs: Keith A. Wire | - | Description: Stuff a Comma in a string | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:28:19pm Time updated: 12:28:19pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: cStrToStuff | - | : lTrimStuffedStr | - | Return Value: cStrToStuff | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Stuff a Comma in a string STATIC FUNCTION _ftStuffComma( cStrToStuff, lTrimStuffedStr ) @@ -1387,22 +1104,9 @@ STATIC FUNCTION _ftStuffComma( cStrToStuff, lTrimStuffedStr ) RETURN cStrToStuff -/*+- Function ---------------------------------------------------------------+ - | Name: _ftSetSCRColor() Docs: Keith A. Wire | - | Description: Set the standard screen colors to the color requested. | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:28:48pm Time updated: 12:28:48pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: nStd | - | : nEnh | - | : nBord | - | : nBack | - | : nUnsel | - | See Also: _ftSetWinColor() | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Set the standard screen colors to the color requested. +// See Also: _ftSetWinColor() STATIC FUNCTION _ftSetSCRColor( nStd, nEnh, nBord, nBack, nUnsel ) @@ -1423,39 +1127,20 @@ STATIC FUNCTION _ftSetSCRColor( nStd, nEnh, nBord, nBack, nUnsel ) t_aStdColor[ nBack ] + "," + ; t_aStdColor[ nUnsel ] ) -/*+- Function ---------------------------------------------------------------+ - | Name: _ftPushWin() Docs: Keith A. Wire | - | Description: Push a new window on the screen | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:34:38pm Time updated: 12:34:38pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: t | - | : l | - | : b | - | : r | - | : cTitle | - | : cBotTitle | - | : nWinColor | - | Return Value: NIL | - | See Also: | - | Notes: Push a new window on the screen in the position t,l,b,r | - | : and if cTitle is not NIL print the title for the window | - | : in centered in the top line of the box. Similarly do | - | : the same for cBotTitle. If nWinColor==NIL get the next | - | : window color and use it for all the colors. If | - | : cTypeBord==NIL use the single line border, else use the | - | : one they requested. Push the window coordinates, the | - | : color number, the SAVESCREEN() value, and whether they | - | : picked the window color they wanted to use. If | - | : lAutoWindow=.F. then the window color was incremented | - | : and we will will restore the color number when we pop | - | : the window off. | - | : | - | : nWinColor DEFAULT == _ftNextWinColor() | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// NOTE: Push a new window on the screen in the position t,l,b,r +// and if cTitle is not NIL print the title for the window +// in centered in the top line of the box. Similarly do +// the same for cBotTitle. If nWinColor==NIL get the next +// window color and use it for all the colors. If +// cTypeBord==NIL use the single line border, else use the +// one they requested. Push the window coordinates, the +// color number, the SAVESCREEN() value, and whether they +// picked the window color they wanted to use. If +// lAutoWindow=.F. then the window color was incremented +// and we will will restore the color number when we pop +// the window off. +// nWinColor DEFAULT == _ftNextWinColor() STATIC FUNCTION _ftPushWin( t, l, b, r, cTitle, cBotTitle, nWinColor ) @@ -1482,25 +1167,15 @@ STATIC FUNCTION _ftPushWin( t, l, b, r, cTitle, cBotTitle, nWinColor ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftPopWin Docs: Keith A. Wire | - | Description: Pop a Window off the screen | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 12:52:34pm Time updated: 12:52:34pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: None | - | Return Value: NIL | - | Notes: Pop the currently active window off the screen by restoring| - | : it from the t_aWindow Array and if they pushed a new window| - | : automatically selecting the color we will roll back the | - | : current window setting using _ftLastWinColor() and reset | - | : the color to the color setting when window was pushed. | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Pop a Window off the screen +// NOTE: Pop the currently active window off the screen by restoring +// it from the t_aWindow Array and if they pushed a new window +// automatically selecting the color we will roll back the +// current window setting using _ftLastWinColor() and reset +// the color to the color setting when window was pushed. -STATIC FUNCTION _ftPopWin +STATIC FUNCTION _ftPopWin() LOCAL nNumWindow := Len( t_aWindow ) @@ -1522,25 +1197,11 @@ STATIC FUNCTION _ftPopWin RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftSetWinColor() Docs: Keith A. Wire | - | Description: Set the Color to the Window Colors requested | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 01:37:32pm Time updated: 01:37:32pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: nWin | - | : nStd | - | : nEnh | - | : nBord | - | : nBack | - | : nUnsel | - | See Also: _ftSetSCRColor() | - | Notes: If the window number is not passed use the currently active| - | : window number nWinColor. | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Set the Color to the Window Colors requested +// See Also: _ftSetSCRColor() +// NOTE: If the window number is not passed use the currently +// active window number nWinColor. STATIC FUNCTION _ftSetWinColor( nWin, nStd, nEnh, nBord, nBack, nUnsel ) @@ -1558,37 +1219,17 @@ STATIC FUNCTION _ftSetWinColor( nWin, nStd, nEnh, nBord, nBack, nUnsel ) t_aWinColor[ nBack, nWin ] + "," + ; t_aWinColor[ nUnsel, nWin ] ) -/*+- Function ---------------------------------------------------------------+ - | Name: _ftLastWinColor Docs: Keith A. Wire | - | Description: Decrement the active window color number and return the | - | : current value | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 01:49:19pm Time updated: 01:49:19pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: None | - | Notes: If we are already on window #1 restart count by using # 4. | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Decrement the active window color number and return the current value +// NOTE: If we are already on window #1 restart count by using # 4. STATIC FUNCTION _ftLastWinColor() RETURN t_nWinColor := iif( t_nWinColor == 1, 4, t_nWinColor - 1 ) -/*+- Function ---------------------------------------------------------------+ - | Name: _ftNextWinColor Docs: Keith A. Wire | - | Description: Increment the active window color number and return the | - | : current value | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 01:51:12pm Time updated: 01:51:12pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: None | - | Notes: If we are already on window #4 restart count by using # 1. | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Increment the active window color number and return the current value +// NOTE: If we are already on window #4 restart count by using # 1. STATIC FUNCTION _ftNextWinColor() @@ -1598,20 +1239,9 @@ STATIC FUNCTION _ftNextWinColor() RETURN t_nWinColor := ( iif( t_nWinColor < 4, t_nWinColor + 1, 1 ) ) -/*+- Function ---------------------------------------------------------------+ - | Name: _ftWinTitle() Docs: Keith A. Wire | - | Description: Print the top or bottom titles on the border of the | - | : currently active window. | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 01:52:29pm Time updated: 01:52:29pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: cTheTitle | - | : cTopOrBot | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Print the top or bottom titles on the border of the currently +// active window. STATIC FUNCTION _ftWinTitle( cTheTitle, cTopOrBot ) @@ -1623,20 +1253,10 @@ STATIC FUNCTION _ftWinTitle( cTheTitle, cTopOrBot ) RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftInitColors Docs: Keith A. Wire | - | Description: Initilize the colors for the Adder | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 02:59:58pm Time updated: 02:59:58pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: None | - | Return Value: NIL | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Initilize the colors for the Adder -STATIC FUNCTION _ftInitColors +STATIC FUNCTION _ftInitColors() t_aWinColor := { ; { "GR+/BG","GR+/G", "B+/RB", "G+/R" } ,; @@ -1660,70 +1280,29 @@ STATIC FUNCTION _ftInitColors RETURN NIL -/*+- Function ---------------------------------------------------------------+ - | Name: _ftPosRepl() Docs: Keith A. Wire | - | Description: Replace the Character at nPosit in cString with cChar | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 01:44:21pm Time updated: 01:44:21pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: cString | - | : cChar | - | : nPosit | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Replace the Character at nPosit in cString with cChar STATIC FUNCTION _ftPosRepl( cString, cChar, nPosit ) RETURN StrTran( cString, "9", cChar, nPosit, 1 ) + "" -/*+- Function ---------------------------------------------------------------+ - | Name: _ftCharRem() Docs: Keith A. Wire | - | Description: Removes all occurances of cChar from cString. | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 01:45:41pm Time updated: 01:45:41pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: cChar | - | : cString | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Removes all occurances of cChar from cString. STATIC FUNCTION _ftCharRem( cChar, cString ) RETURN StrTran( cString, cChar ) -/*+- Function ---------------------------------------------------------------+ - | Name: _ftCountLeft() Docs: Keith A. Wire | - | Description: Returns the number of spaces on the Left side of the String| - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 01:47:00pm Time updated: 01:47:00pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: cString | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Returns the number of spaces on the Left side of the String STATIC FUNCTION _ftCountLeft( cString ) RETURN Len( cString ) - Len( LTrim( cString ) ) -/*+- Function ---------------------------------------------------------------+ - | Name: _ftPosIns() Docs: Keith A. Wire | - | Description: Insert the Character cChar in cString at position nPosit | - | Author: Keith A. Wire | - | Date created: 10-03-93 Date updated: 10-03-93 | - | Time created: 01:48:30pm Time updated: 01:48:30pm | - | Copyright: None - Public Domain | - +--------------------------------------------------------------------------+ - | Arguments: cString | - | : cChar | - | : nPosit | - +--------------------------------------------------------------------------+ -*/ +//---------------------------------------------------------- +// Insert the Character cChar in cString at position nPosit STATIC FUNCTION _ftPosIns( cString, cChar, nPosit ) diff --git a/harbour/contrib/hbnf/rand1.prg b/harbour/contrib/hbnf/rand1.prg index 6109ef732a..dba88765c5 100644 --- a/harbour/contrib/hbnf/rand1.prg +++ b/harbour/contrib/hbnf/rand1.prg @@ -29,6 +29,6 @@ FUNCTION ft_rand1( nMax ) LOCAL m := 100000000, b := 31415621 - t_nSeed := iif( t_nSeed == NIL, Seconds(), t_nSeed ) // init_seed() + t_nSeed := iif( t_nSeed == NIL, Seconds(), t_nSeed ) RETURN nMax * ( ( t_nSeed := Mod( t_nSeed * b + 1, m ) ) / m ) diff --git a/harbour/contrib/hbnf/round.prg b/harbour/contrib/hbnf/round.prg index 50c216d430..6577255f87 100644 --- a/harbour/contrib/hbnf/round.prg +++ b/harbour/contrib/hbnf/round.prg @@ -89,7 +89,7 @@ FUNCTION FT_ROUND( nNumber, nRoundToAmount, cRoundType, cRoundDirection, ; nResult := Int( nResult / nRoundToAmount ) * nRoundToAmount - OTHERWISE // Round Normally + OTHERWISE // Round Normally nResult := Int( ( nResult + nRoundToAmount / 2 ) / nRoundToAmount ) * ; nRoundToAmount diff --git a/harbour/contrib/hbnf/sqzn.prg b/harbour/contrib/hbnf/sqzn.prg index 2bc9991aae..8bf51bb6e2 100644 --- a/harbour/contrib/hbnf/sqzn.prg +++ b/harbour/contrib/hbnf/sqzn.prg @@ -47,10 +47,10 @@ FUNCTION ft_unsqzn( cCompressed, nSize, nDecimals ) cCompressed := iif( multi == -1, hb_BSubStr( cCompressed, 2 ), cCompressed ) nSize := iif( nSize / 2 != Int( nSize / 2 ), nSize + 1, nSize ) IF hb_BCode( cCompressed ) > 127 - tmp := Str( hb_BCode( cCompressed ) - 128, 2 ) - multi := -1 + tmp := Str( hb_BCode( cCompressed ) - 128, 2 ) + multi := -1 ELSE - tmp := Str( hb_BCode( cCompressed ), 2 ) + tmp := Str( hb_BCode( cCompressed ), 2 ) ENDIF FOR k := 2 TO hb_BLen( cCompressed ) diff --git a/harbour/contrib/hbnf/tbwhile.prg b/harbour/contrib/hbnf/tbwhile.prg index b2d186acb6..60d8cbbc44 100644 --- a/harbour/contrib/hbnf/tbwhile.prg +++ b/harbour/contrib/hbnf/tbwhile.prg @@ -58,7 +58,7 @@ #include "set.ch" #include "setcurs.ch" -/* ------------------------------------------------------------------- */ +// FUNCTION FT_BRWSWHL( aFields, bWhileCond, cKey, nFreeze, lSaveScrn, ; cColorList, cColorShad, nTop, nLeft, nBottom, nRight ) @@ -79,7 +79,7 @@ FUNCTION FT_BRWSWHL( aFields, bWhileCond, cKey, nFreeze, lSaveScrn, ; lKeepScrn := PCount() > 6 - SEEK cKey + dbSeek( cKey ) IF ! Found() .OR. LastRec() == 0 RETURN 0 ENDIF @@ -144,7 +144,7 @@ FUNCTION FT_BRWSWHL( aFields, bWhileCond, cKey, nFreeze, lSaveScrn, ; IF ! lKeepScrn SetColor( cColorBack ) - CLS + hb_Scroll() ENDIF /* make a window shadow */ @@ -156,6 +156,7 @@ FUNCTION FT_BRWSWHL( aFields, bWhileCond, cKey, nFreeze, lSaveScrn, ; lMore := .T. DO WHILE lMore + /* stabilize the display */ nKey := 0 DispBegin() @@ -175,8 +176,7 @@ FUNCTION FT_BRWSWHL( aFields, bWhileCond, cKey, nFreeze, lSaveScrn, ; // up-to-date data in case we are on a network. DispBegin() b:refreshCurrent() - DO WHILE ! b:stabilize() - ENDDO + b:forceStable() DispEnd() /* everything's done. just wait for a key */ @@ -263,7 +263,7 @@ FUNCTION FT_BRWSWHL( aFields, bWhileCond, cKey, nFreeze, lSaveScrn, ; RETURN nPassRec -/* -------------------------------------------------------------------- */ +// STATIC FUNCTION TbSkipWhil( n, bWhileCond ) @@ -297,15 +297,15 @@ STATIC FUNCTION TbSkipWhil( n, bWhileCond ) RETURN i -/* -------------------------------------------------------------------- */ +// STATIC FUNCTION TbWhileTop( cKey ) - SEEK cKey + dbSeek( cKey ) RETURN NIL -/* -------------------------------------------------------------------- */ +// STATIC FUNCTION TbWhileBot( cKey ) @@ -316,9 +316,7 @@ STATIC FUNCTION TbWhileBot( cKey ) // string cKey by one ascii character. After SEEKing the new string, // back up one record to get to the last record which matches cKey. - LOCAL cSoftSave := Set( _SET_SOFTSEEK, .T. ) - SEEK Left( cKey, Len( cKey ) - 1 ) + Chr( Asc( Right( cKey, 1 ) ) + 1 ) - Set( _SET_SOFTSEEK, cSoftSave ) - SKIP -1 + dbSeek( Left( cKey, Len( cKey ) - 1 ) + Chr( Asc( Right( cKey, 1 ) ) + 1 ), .T. ) + dbSkip( -1 ) RETURN NIL diff --git a/harbour/contrib/hbnf/week.prg b/harbour/contrib/hbnf/week.prg index 9ecc79e60f..b3b61d8650 100644 --- a/harbour/contrib/hbnf/week.prg +++ b/harbour/contrib/hbnf/week.prg @@ -49,7 +49,7 @@ FUNCTION FT_WEEK( dGivenDate, nWeekNum ) dGivenDate := aRetVal[ 2 ] + ( nWeekNum - 1 ) * 7 ENDIF - dGivenDate += ( 6 - FT_DAYTOBOW( dGivenDate ) ) // end of week + dGivenDate += 6 - FT_DAYTOBOW( dGivenDate ) // end of week aRetVal[ 1 ] += StrZero( Int( ( dGivenDate - aRetVal[ 2 ] ) / 7 ) + 1, 2 ) aRetVal[ 2 ] := Max( dGivenDate - 6, dTemp ) diff --git a/harbour/contrib/hbnf/woy.prg b/harbour/contrib/hbnf/woy.prg index 47517d161c..4bbe95cfd9 100644 --- a/harbour/contrib/hbnf/woy.prg +++ b/harbour/contrib/hbnf/woy.prg @@ -33,17 +33,14 @@ FUNCTION FT_WOY( dInDate ) cCentury := Left( DToS( dInDate ), 4 ) // find number of days in first week of year - nFirstDays := 8 - DOW( SToD( cCentury + "0101" ) ) nWkNumber := 1 // find how many days after first week till dInDate - nDayOffset := ( dInDate - SToD( cCentury + "0101" ) ) - nFirstDays + 1 // count weeks in offset period - DO WHILE nDayOffset > 0 ++nWkNumber nDayOffset -= 7