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

2010-05-25 09:21 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* contrib/hbct/ctrand.prg
  * contrib/hbct/getsecrt.prg
  * contrib/hbct/keysec.prg
  * contrib/hbct/getinput.prg
  * contrib/hbct/screen3.prg
  * contrib/hbct/ct.prg
  * contrib/hbct/cttime.prg
  * contrib/hbct/numconv.prg
  * contrib/hbct/showtime.prg
  * contrib/hbct/ctmisc.prg
  * contrib/hbct/getinfo.prg
  * contrib/hbct/scrmark.prg
  * contrib/hbct/keysave.prg
  * contrib/hbct/fcopy.prg
    ! Fixed formatting.
    ! Fixed to use proper type validation instead of 'DEFAULT TO'.
    ! Fixed to use F_ERROR instead of -1.
This commit is contained in:
Viktor Szakats
2010-05-25 07:26:37 +00:00
parent b539031c2c
commit 6fce1cd697
15 changed files with 284 additions and 252 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
harbour/ChangeLog
View File

@@ -17,31 +17,48 @@
past entries belonging to author(s): Viktor Szakats.
*/
2010-05-25 09:21 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
* contrib/hbct/ctrand.prg
* contrib/hbct/getsecrt.prg
* contrib/hbct/keysec.prg
* contrib/hbct/getinput.prg
* contrib/hbct/screen3.prg
* contrib/hbct/ct.prg
* contrib/hbct/cttime.prg
* contrib/hbct/numconv.prg
* contrib/hbct/showtime.prg
* contrib/hbct/ctmisc.prg
* contrib/hbct/getinfo.prg
* contrib/hbct/scrmark.prg
* contrib/hbct/keysave.prg
* contrib/hbct/fcopy.prg
! Fixed formatting.
! Fixed to use proper type validation instead of 'DEFAULT TO'.
! Fixed to use F_ERROR instead of -1.
2010-05-24 20:53 UTC-0500 Teo Fonrouge (teo/at/windtelsoft/dot/com)
* ChangeLog
! Fixed previous not accurate ChangeLog entry
* ChangeLog
! Fixed previous not accurate ChangeLog entry
2010-05-24 19:37 UTC-0500 Teo Fonrouge (teo/at/windtelsoft/dot/com)
* contrib/hbtip/tests/dbtohtml.prg
! end tags fixed
* using HB_SYMBOL_UNUSED to pacify Harbour warnings ( -w3 )
* contrib/hbtip/tests/dbtohtml.prg
! end tags fixed
* using HB_SYMBOL_UNUSED to pacify Harbour warnings ( -w3 )
2010-05-24 19:19 UTC-0500 Teo Fonrouge (teo/at/windtelsoft/dot/com)
* contrib/hbtip/thtml.prg
* removed FOR EACH limitation in source code imported from xHarbour
Harbour never had such limitation. xHarbour still have it.
(thanks to Przemek for pointing this and for superb compiler BTW)
* using HB_OSNewLine() as eol
% on ::popNode added capability to check if end tags for the following
tags are found: "tr","th","td"
to end this tags, the user simply needs to call the current node
with the minus ( - ) operator for the tag requiered to close:
node - "th"
* ChangeLog
! Fixed wrong entry on my previous commit
* contrib/hbtip/thtml.prg
* removed FOR EACH limitation in source code imported from xHarbour
Harbour never had such limitation. xHarbour still have it.
(thanks to Przemek for pointing this and for superb compiler BTW)
* using HB_OSNewLine() as eol
% on ::popNode added capability to check if end tags for the following
tags are found: "tr","th","td"
to end this tags, the user simply needs to call the current node
with the minus ( - ) operator for the tag requiered to close:
node - "th"
* ChangeLog
! Fixed wrong entry on my previous commit
2010-05-24 15:09 UTC-0800 Pritpal Bedi (pritpal@vouchcac.com)
* contrib/hbide/ideprojmanager.prg

45
harbour/contrib/hbct/ct.prg
View File

@@ -52,8 +52,7 @@
*
*/
static sbInitialized := .F.
STATIC s_bInitialized := .F.
/* $DOC$
@@ -89,21 +88,21 @@ static sbInitialized := .F.
* $END$
*/
function CTINIT()
FUNCTION CTINIT()
if !sbInitialized
sbInitialized := ctcinit()
endif
IF ! s_bInitialized
s_bInitialized := ctcinit()
ENDIF
return sbInitialized
RETURN s_bInitialized
init function _CTINIT()
INIT FUNCTION _CTINIT()
if !sbInitialized
sbInitialized := ctcinit()
endif
IF ! s_bInitialized
s_bInitialized := ctcinit()
ENDIF
return sbInitialized
RETURN s_bInitialized
/* $DOC$
@@ -139,20 +138,20 @@ return sbInitialized
* $END$
*/
function CTEXIT()
FUNCTION CTEXIT()
if sbInitialized
IF s_bInitialized
ctcexit()
sbInitialized := .F.
endif
s_bInitialized := .F.
ENDIF
return nil
RETURN NIL
exit function _CTEXIT()
EXIT FUNCTION _CTEXIT()
if sbInitialized
ctcexit()
sbInitialized := .F.
endif
IF s_bInitialized
ctcexit()
s_bInitialized := .F.
ENDIF
return nil
RETURN NIL

16
harbour/contrib/hbct/ctmisc.prg
View File

@@ -60,21 +60,29 @@ MEMVAR GetList
FUNCTION AlloFree( lMode )
DEFAULT lMode TO .F.
IF ! ISLOGICAL( lMode )
lMode := .F.
ENDIF
RETURN Memory( iif( lMode, HB_MEM_CHAR, HB_MEM_BLOCK ) )
FUNCTION CENTER( c, n, p, lMode )
LOCAL cRet
DEFAULT n TO MaxCol() + 1 - Col() * 2
DEFAULT c TO ""
IF ! ISNUMBER( n )
n := MaxCol() + 1 - Col() * 2
ENDIF
IF ! ISCHARACTER( c )
c := ""
ENDIF
IF ISLOGICAL( p )
lMode := p
p := NIL
ELSE
DEFAULT lMode TO .F.
IF ! ISLOGICAL( lMode )
lMode := .F.
ENDIF
ENDIF
cRet := PadC( RTrim( c ), n, p )

6
harbour/contrib/hbct/ctrand.prg
View File

@@ -53,11 +53,11 @@
#include "common.ch"
FUNCTION Random( lMode )
RETURN IIF( ISLOGICAL( lMode ) .AND. lMode, ;
HB_RandomInt( -32768, 32767 ), HB_RandomInt( 0, 65535 ) )
RETURN IIF( ISLOGICAL( lMode ) .AND. lMode, ;
HB_RandomInt( -32768, 32767 ), HB_RandomInt( 0, 65535 ) )
FUNCTION Rand( nStart )
IF nStart != NIL
HB_RandomSeed( nStart )
ENDIF
RETURN HB_Random()
RETURN HB_Random()

90
harbour/contrib/hbct/cttime.prg
View File

@@ -53,49 +53,55 @@
#include "common.ch"
function TIMETOSEC( cTime )
local nSec := 0, nLen, i, aLim, aMod, nInd, n
if cTime == NIL
nSec := seconds()
elseif ISCHARACTER( cTime )
nLen := len( cTime )
if ( nLen + 1 ) % 3 == 0 .and. nLen <= 11
nInd := 1
aLim := { 24, 60, 60, 100 }
aMod := { 3600, 60, 1, 1/100 }
for i := 1 to nLen step 3
if isdigit( substr( cTime, i, 1 ) ) .and. ;
isdigit( substr( cTime, i + 1, 1 ) ) .and. ;
( i == nLen - 1 .or. substr( cTime, i + 2, 1 ) == ":" ) .and. ;
( n := val( substr( cTime, i, 2 ) ) ) < aLim[ nInd ]
nSec += n * aMod[ nInd ]
else
nSec := 0
exit
endif
++nInd
next
endif
endif
return round( nSec, 2) /* round FL val to be sure that you can compare it */
FUNCTION TIMETOSEC( cTime )
LOCAL nSec := 0
LOCAL nLen, i, aLim, aMod, nInd, n
IF cTime == NIL
nSec := Seconds()
ELSEIF ISCHARACTER( cTime )
nLen := Len( cTime )
IF ( nLen + 1 ) % 3 == 0 .AND. nLen <= 11
nInd := 1
aLim := { 24, 60, 60, 100 }
aMod := { 3600, 60, 1, 1 / 100 }
FOR i := 1 TO nLen STEP 3
IF IsDigit( SubStr( cTime, i, 1 ) ) .AND. ;
IsDigit( SubStr( cTime, i + 1, 1 ) ) .AND. ;
( i == nLen - 1 .OR. SubStr( cTime, i + 2, 1 ) == ":" ) .AND. ;
( n := Val( SubStr( cTime, i, 2 ) ) ) < aLim[ nInd ]
nSec += n * aMod[ nInd ]
ELSE
nSec := 0
EXIT
ENDIF
++nInd
NEXT
ENDIF
ENDIF
function SECTOTIME( nSec, lHundr )
local i, h, n
n := iif( !ISNUMBER( nSec ), seconds(), nSec )
if ISLOGICAL( lHundr ) .and. lHundr
h := ":" + strzero( ( nSec * 100 ) % 100, 2 )
else
h := ""
endif
n := int( n % 86400 )
for i := 1 to 3
h := strzero( n % 60, 2 ) + iif( len( h ) == 0, "", ":") + h
n := int( n / 60 )
next
return h
RETURN Round( nSec, 2 ) /* round FL val to be sure that you can compare it */
FUNCTION SECTOTIME( nSec, lHundr )
LOCAL i, h, n
function MILLISEC( nDelay )
HB_IDLESLEEP( nDelay / 1000 )
return ""
n := iif( ! ISNUMBER( nSec ), Seconds(), nSec )
IF ISLOGICAL( lHundr ) .AND. lHundr
h := ":" + StrZero( ( nSec * 100 ) % 100, 2 )
ELSE
h := ""
ENDIF
n := Int( n % 86400 )
FOR i := 1 TO 3
h := StrZero( n % 60, 2 ) + iif( Len( h ) == 0, "", ":" ) + h
n := Int( n / 60 )
NEXT
RETURN h
FUNCTION MILLISEC( nDelay )
HB_IDLESLEEP( nDelay / 1000 )
RETURN ""

49
harbour/contrib/hbct/fcopy.prg
View File

@@ -67,12 +67,12 @@
*/
#include "fileio.ch"
#include "common.ch"
#include "fileio.ch"
#define F_BLOCK 512
#define F_BLOCK 512
THREAD STATIC t_hSrcFile := -1
THREAD STATIC t_hSrcFile := F_ERROR
THREAD STATIC t_lSetDaTi := .T.
THREAD STATIC t_fileDate
THREAD STATIC t_fileTime
@@ -88,16 +88,16 @@ FUNCTION FILECOPY( cSource, cDest, lMode )
LOCAL lDone := .F.
LOCAL nSrcBytes, nDstBytes, nTotBytes := 0
IF !ISLOGICAL( lMode )
IF ! ISLOGICAL( lMode )
lMode := .F.
ENDIF
IF t_hSrcFile != -1
IF t_hSrcFile != F_ERROR
FCLOSE( t_hSrcFile )
ENDIF
t_hSrcFile := FOPEN( cSource, FO_READ )
IF t_hSrcFile != -1
IF t_hSrcFile != F_ERROR
hDstFile := FCREATE( cDest )
IF hDstFile != -1
IF hDstFile != F_ERROR
DO WHILE !lDone
nSrcBytes := FREAD( t_hSrcFile, @cBuffer, F_BLOCK )
IF nSrcBytes == 0
@@ -115,7 +115,7 @@ FUNCTION FILECOPY( cSource, cDest, lMode )
FCLOSE( hDstFile )
IF lDone .OR. !lMode
FCLOSE( t_hSrcFile )
t_hSrcFile := -1
t_hSrcFile := F_ERROR
ENDIF
t_fileDate := FILEDATE( cSource )
t_fileTime := FILETIME( cSource )
@@ -124,23 +124,22 @@ FUNCTION FILECOPY( cSource, cDest, lMode )
ENDIF
ELSE
FCLOSE( t_hSrcFile )
t_hSrcFile := -1
t_hSrcFile := F_ERROR
ENDIF
ENDIF
RETURN nTotBytes
RETURN nTotBytes
FUNCTION FILECOPEN()
RETURN t_hSrcFile != -1
RETURN t_hSrcFile != F_ERROR
FUNCTION FILECDATI( lNewMode )
LOCAL lOldMode := t_lSetDaTi
IF ISLOGICAL( lNewMode )
t_lSetDaTi := lNewMode
ENDIF
RETURN lOldMode
RETURN lOldMode
FUNCTION FILECCONT( cDest )
LOCAL hDstFile
@@ -148,9 +147,9 @@ FUNCTION FILECCONT( cDest )
LOCAL lDone := .F.
LOCAL nSrcBytes, nDstBytes, nTotBytes := 0
IF t_hSrcFile != -1
IF t_hSrcFile != F_ERROR
hDstFile := FCREATE( cDest )
IF hDstFile != -1
IF hDstFile != F_ERROR
DO WHILE !lDone
nSrcBytes := FREAD( t_hSrcFile, @cBuffer, F_BLOCK )
IF nSrcBytes == 0
@@ -168,24 +167,22 @@ FUNCTION FILECCONT( cDest )
FCLOSE( hDstFile )
IF lDone
FCLOSE( t_hSrcFile )
t_hSrcFile := -1
t_hSrcFile := F_ERROR
ENDIF
IF t_lSetDaTi
SETFDATI( cDest, t_fileDate, t_fileTime )
ENDIF
ENDIF
ENDIF
RETURN nTotBytes
RETURN nTotBytes
FUNCTION FILECCLOSE()
IF t_hSrcFile != -1
IF t_hSrcFile != F_ERROR
FCLOSE( t_hSrcFile )
t_hSrcFile := -1
t_hSrcFile := F_ERROR
RETURN .T.
ENDIF
RETURN .F.
RETURN .F.
FUNCTION FILEAPPEND( cSrc, cDest )
LOCAL cBuffer := Space( F_BLOCK )
@@ -193,7 +190,7 @@ FUNCTION FILEAPPEND( cSrc, cDest )
LOCAL nSrcBytes, nDstBytes, nTotBytes := 0
hSrcFile := FOPEN( cSrc, FO_READ )
IF hSrcFile != -1
IF hSrcFile != F_ERROR
IF !hb_FileExists( cDest )
hDstFile := FCREATE( cDest )
ELSE
@@ -201,7 +198,7 @@ FUNCTION FILEAPPEND( cSrc, cDest )
FSEEK( hDstFile, 0, FS_END )
ENDIF
IF hDstFile != -1
IF hDstFile != F_ERROR
DO WHILE .T.
nSrcBytes := FREAD( hSrcFile, @cBuffer, F_BLOCK )
IF nSrcBytes == 0
@@ -217,4 +214,4 @@ FUNCTION FILEAPPEND( cSrc, cDest )
ENDIF
FCLOSE( hSrcFile )
ENDIF
RETURN nTotBytes
RETURN nTotBytes

20
harbour/contrib/hbct/getinfo.prg
View File

@@ -60,41 +60,41 @@ MEMVAR GetList
FUNCTION SAVEGETS()
LOCAL aGetList := GetList
GetList := {}
RETURN aGetList
RETURN aGetList
FUNCTION RESTGETS( aGetList )
RETURN ( GetList := aGetList ) != NIL
RETURN ( GetList := aGetList ) != NIL
FUNCTION COUNTGETS()
RETURN LEN( GetList )
RETURN LEN( GetList )
FUNCTION CURRENTGET()
LOCAL oActive := GetActive()
RETURN ASCAN( GetList, {|oGet| oGet == oActive } )
RETURN ASCAN( GetList, {|oGet| oGet == oActive } )
FUNCTION GETFLDROW( nField )
LOCAL oGet
IF !ISNUMBER( nField )
IF ! ISNUMBER( nField )
oGet := GetActive()
ELSEIF nField >= 1 .AND. nField <= LEN( GetList )
oGet := GetList[ nField ]
ENDIF
RETURN IIF( oGet != NIL, oGet:Row, -1 )
RETURN IIF( oGet != NIL, oGet:Row, -1 )
FUNCTION GETFLDCOL( nField )
LOCAL oGet
IF !ISNUMBER( nField )
IF ! ISNUMBER( nField )
oGet := GetActive()
ELSEIF nField >= 1 .AND. nField <= LEN( GetList )
oGet := GetList[ nField ]
ENDIF
RETURN IIF( oGet != NIL, oGet:Col, -1 )
RETURN IIF( oGet != NIL, oGet:Col, -1 )
FUNCTION GETFLDVAR( nField )
LOCAL oGet
IF !ISNUMBER( nField )
IF ! ISNUMBER( nField )
oGet := GetActive()
ELSEIF nField >= 1 .AND. nField <= LEN( GetList )
oGet := GetList[ nField ]
ENDIF
RETURN IIF( oGet != NIL, oGet:Name, -1 )
RETURN IIF( oGet != NIL, oGet:Name, -1 )

8
harbour/contrib/hbct/getinput.prg
View File

@@ -60,13 +60,13 @@ FUNCTION GETINPUT( xVar, nRow, nCol, lSay, xPrompt )
LOCAL nCursorCol := COL()
LOCAL GetList := {}
IF !ISNUMBER( nRow )
IF ! ISNUMBER( nRow )
nRow := nCursorRow
ENDIF
IF !ISNUMBER( nCol )
IF ! ISNUMBER( nCol )
nCol := nCursorCol
ENDIF
IF !ISLOGICAL( lSay )
IF ! ISLOGICAL( lSay )
lSay := .F.
ENDIF
@@ -87,4 +87,4 @@ FUNCTION GETINPUT( xVar, nRow, nCol, lSay, xPrompt )
SETPOS( nCursorRow, nCursorCol )
RETURN xVar
RETURN xVar

25
harbour/contrib/hbct/getsecrt.prg
View File

@@ -63,13 +63,13 @@ FUNCTION GETSECRET( cVar, nRow, nCol, lSay, xPrompt )
LOCAL _cGetSecret := cVar
LOCAL lHide := .T.
IF !ISNUMBER( nRow )
IF ! ISNUMBER( nRow )
nRow := ROW()
ENDIF
IF !ISNUMBER( nCol )
IF ! ISNUMBER( nCol )
nCol := COL()
ENDIF
IF !ISLOGICAL( lSay )
IF ! ISLOGICAL( lSay )
lSay := .F.
ENDIF
@@ -94,18 +94,18 @@ FUNCTION GETSECRET( cVar, nRow, nCol, lSay, xPrompt )
SETPOS( nCursorRow, nCursorCol )
RETURN _cGetSecret
RETURN _cGetSecret
STATIC FUNCTION _HIDE( cVar )
RETURN RANGEREPL( ASC( " " ) + 1, 255, cVar, "*" )
RETURN RANGEREPL( ASC( " " ) + 1, 255, cVar, "*" )
STATIC FUNCTION _VALUE( cVar, lHide, xNew )
IF lHide
RETURN _HIDE( cVar )
ELSEIF xNew != NIL
cVar := PADR( xNew, LEN( cVar ) )
ENDIF
RETURN cVar
IF lHide
RETURN _HIDE( cVar )
ELSEIF xNew != NIL
cVar := PADR( xNew, LEN( cVar ) )
ENDIF
RETURN cVar
STATIC PROCEDURE _SECRET( _cGetSecret, lHide, oGet, oGetList )
LOCAL nKey, nLen, bKeyBlock
@@ -113,6 +113,7 @@ STATIC PROCEDURE _SECRET( _cGetSecret, lHide, oGet, oGetList )
IF oGetList == NIL
oGetList := __GetListActive()
ENDIF
IF GetPreValidate( oGet )
nLen := LEN( _cGetSecret )
@@ -150,4 +151,4 @@ STATIC PROCEDURE _SECRET( _cGetSecret, lHide, oGet, oGetList )
oGet:KillFocus()
ENDIF
RETURN
RETURN

4
harbour/contrib/hbct/keysave.prg
View File

@@ -50,8 +50,8 @@
*/
FUNCTION SAVESETKEY()
RETURN HB_SETKEYSAVE()
RETURN HB_SETKEYSAVE()
FUNCTION RESTSETKEY( aSavedTraps )
HB_SETKEYSAVE( aSavedTraps )
RETURN .T.
RETURN .T.

13
harbour/contrib/hbct/keysec.prg
View File

@@ -63,16 +63,16 @@ FUNCTION KeySec( nKey, nTime, nCounter, lMode )
ENDIF
IF ISNUMBER( nKey )
IF !ISNUMBER( nTime )
IF ! ISNUMBER( nTime )
nTime := 0
ELSEIF nTime < 0
nTime := -nTime / 18.2
ENDIF
IF !ISNUMBER( nCounter )
IF ! ISNUMBER( nCounter )
nCounter := 1
ENDIF
IF !ISLOGICAL( lMode )
lMode := .f.
IF ! ISLOGICAL( lMode )
lMode := .F.
ENDIF
nSeconds := SECONDS()
@@ -81,7 +81,7 @@ FUNCTION KeySec( nKey, nTime, nCounter, lMode )
RETURN .T.
ENDIF
RETURN .F.
RETURN .F.
STATIC PROCEDURE doKeySec( nKey, nTime, lMode, nCounter, nSeconds )
LOCAL nSec := SECONDS()
@@ -100,4 +100,5 @@ STATIC PROCEDURE doKeySec( nKey, nTime, lMode, nCounter, nSeconds )
nSeconds := nSec
ENDIF
ENDIF
RETURN
RETURN

176
harbour/contrib/hbct/numconv.prg
View File

@@ -54,7 +54,8 @@
*/
#include "common.ch"
#define WORLD '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
#define WORLD "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
/* $DOC$
* $FUNCNAME$
@@ -83,34 +84,38 @@
*/
FUNCTION NTOC( xNum, nBase, nLenght, cPad )
LOCAL cNum
LOCAL cNum
Default cPad to " "
Default nBase to 10
IF ISCHARACTER( xNum )
xNum := UPPER( ALLTRIM( xNum ) )
xNum := CTON( xNum, 16 )
ENDIF
IF nBase > 36 .OR. nBase < 2
RETURN ""
ENDIF
if xNum < 0
xNum += 4294967296
endif
cNum := B10TOBN( xNum, @nBase )
IF ISNUMBER( nLenght )
IF LEN(cNum) > nLenght
cNum := REPLICATE( "*", nLenght )
ELSEIF ISCHARACTER( cPad ) .AND. LEN( cNum ) < nLenght
cNum := REPLICATE( cPad, nLenght - LEN( cNum ) ) + cNum
IF ! ISCHARACTER( cPad )
cPad := " "
ENDIF
IF ! ISNUMBER( nBase )
nBase := 10
ENDIF
ENDIF
RETURN cNum
IF ISCHARACTER( xNum )
xNum := Upper( AllTrim( xNum ) )
xNum := CTON( xNum, 16 )
ENDIF
IF nBase > 36 .OR. nBase < 2
RETURN ""
ENDIF
IF xNum < 0
xNum += 4294967296
ENDIF
cNum := B10TOBN( xNum, @nBase )
IF ISNUMBER( nLenght )
IF Len( cNum ) > nLenght
cNum := Replicate( "*", nLenght )
ELSEIF ISCHARACTER( cPad ) .AND. Len( cNum ) < nLenght
cNum := Replicate( cPad, nLenght - Len( cNum ) ) + cNum
ENDIF
ENDIF
RETURN cNum
/* $DOC$
* $FUNCNAME$
@@ -139,48 +144,50 @@ RETURN cNum
*/
FUNCTION CTON( xNum, nBase, lMode )
LOCAL i, nNum := 0, nPos
LOCAL i
LOCAL nNum := 0
LOCAL nPos
Default lMode TO .F.
Default nBase TO 10
IF ISCHARACTER(xNum) .and. nBase >= 2 .and. nBase <= 36
xNum := UPPER( ALLTRIM( xNum) )
FOR i := 1 TO LEN( xNum )
nPos := AT( SUBSTR( xNum, i, 1 ), WORLD )
IF nPos == 0 .or. nPos > nBase
EXIT
ELSE
nNum := nNum * nBase + ( nPos - 1 )
ENDIF
NEXT
IF lMode
IF nNum > 32767
nNum := nNum - 65536
ENDIF
IF ! ISLOGICAL( lMode )
lMode := .F.
ENDIF
IF ! ISNUMBER( nBase )
nBase := 10
ENDIF
ENDIF
IF ISCHARACTER( xNum ) .AND. nBase >= 2 .AND. nBase <= 36
RETURN nNum
xNum := Upper( AllTrim( xNum) )
FOR i := 1 TO Len( xNum )
nPos := At( SubStr( xNum, i, 1 ), WORLD )
IF nPos == 0 .OR. nPos > nBase
EXIT
ELSE
nNum := nNum * nBase + ( nPos - 1 )
ENDIF
NEXT
IF lMode .AND. nNum > 32767
nNum := nNum - 65536
ENDIF
ENDIF
RETURN nNum
STATIC FUNCTION B10TOBN( nNum, nBase )
LOCAL nInt
IF nNum > 0
LOCAL nInt
nInt := INT( nNum / nBase)
RETURN iif(nInt==0, "", B10TOBN( nInt, @nBase )) +;
SUBSTR( WORLD, ( nNum % nBase ) + 1, 1 )
ELSEIF nNum == 0
RETURN "0"
ENDIF
RETURN ""
IF nNum > 0
nInt := Int( nNum / nBase)
RETURN iif( nInt == 0, "", B10TOBN( nInt, @nBase ) ) +;
SubStr( WORLD, ( nNum % nBase ) + 1, 1 )
ELSEIF nNum == 0
RETURN "0"
ENDIF
RETURN ""
/* $DOC$
* $FUNCNAME$
@@ -209,30 +216,26 @@ RETURN ""
*/
FUNCTION BITTOC( nInteger, cBitPattern, lMode )
LOCAL cBinary
LOCAL nI
LOCAL cString := ""
LOCAL cBinary, nI, cString := ''
IF ! ISLOGICAL( lMode )
lMode := .F.
ENDIF
Default lMode TO .F.
cBitPattern := Right( cBitPattern, 16 )
cBinary := NTOC( nInteger, 2, 16 )
FOR nI := 1 TO 16
IF SubStr( cBinary, -nI, 1 ) == "1"
cString := SubStr( cBitPattern, -nI, 1 ) + cString
ELSEIF lMode
cString := " " + cString
ENDIF
NEXT
cBitPattern := RIGHT( cBitPattern, 16 )
cBinary := NTOC( nInteger, 2, 16 )
FOR nI := 1 TO 16
IF SUBSTR( cBinary, -nI, 1 ) == '1'
cString := SUBSTR( cBitPattern, -nI, 1 ) + cString
ELSEIF lMode
cString := ' ' + cString
ENDIF
NEXT
RETURN RIGHT( cString, LEN( cBitPattern ) )
RETURN Right( cString, Len( cBitPattern ) )
/* $DOC$
* $FUNCNAME$
@@ -261,16 +264,13 @@ RETURN RIGHT( cString, LEN( cBitPattern ) )
*/
FUNCTION CTOBIT( cCharString, cBitPattern )
LOCAL nI, cString := ""
LOCAL nI, cString := ''
cCharString := Right( cCharString, 16 )
cBitPattern := Right( cBitPattern, 16 )
cCharString := RIGHT( cCharString, 16 )
cBitPattern := RIGHT( cBitPattern, 16 )
FOR nI := 1 TO Len( cBitPattern )
cString := iif( At( SubStr( cBitPattern, -nI, 1 ), cCharString ) > 0, "1", "0" ) + cString
NEXT
FOR nI := 1 TO LEN( cBitPattern )
cString := iif( AT(SUBSTR( cBitPattern, -nI, 1), cCharString) > 0, '1', '0') + cString
NEXT
RETURN CTON( cString, 2 )
RETURN CTON( cString, 2 )

10
harbour/contrib/hbct/screen3.prg
View File

@@ -56,16 +56,16 @@
#include "common.ch"
FUNCTION CLEAREOL( nRow, nCol, xAttr, xChar )
IF !ISNUMBER( nRow )
IF ! ISNUMBER( nRow )
nRow := ROW()
ENDIF
RETURN CLEARWIN( nRow, nCol, nRow, /*MAXCOL()*/, xAttr, xChar )
RETURN CLEARWIN( nRow, nCol, nRow, /*MAXCOL()*/, xAttr, xChar )
FUNCTION CLEOL( nRow, nCol )
IF !ISNUMBER( nRow )
IF ! ISNUMBER( nRow )
nRow := ROW()
ENDIF
RETURN CLEARWIN( nRow, nCol, nRow, /*MAXCOL()*/, 7 /*"W/N"*/, " " )
RETURN CLEARWIN( nRow, nCol, nRow, /*MAXCOL()*/, 7 /*"W/N"*/, " " )
FUNCTION CLWIN( nRow, nCol )
RETURN CLEARWIN( nRow, nCol, /*MAXROW()*/, /*MAXCOL()*/, 7 /*"W/N"*/, " " )
RETURN CLEARWIN( nRow, nCol, /*MAXROW()*/, /*MAXCOL()*/, 7 /*"W/N"*/, " " )

16
harbour/contrib/hbct/scrmark.prg
View File

@@ -58,20 +58,21 @@
#include "common.ch"
FUNCTION SCREENMARK( cSearch, xAttr, lUpperLower, lAll, cForward, cTrailing )
LOCAL lFound := .f., nCount := 1
LOCAL lFound := .F.
LOCAL nCount := 1
LOCAL nAt, nLen, nLast, nRow, nCol, nEnd, nCols
LOCAL cScreen
IF !ISLOGICAL( lUpperLower )
IF ! ISLOGICAL( lUpperLower )
lUpperLower := .F.
ENDIF
IF !ISLOGICAL( lAll )
IF ! ISLOGICAL( lAll )
lAll := .F.
ENDIF
IF !ISCHARACTER( cForward ) .OR. cForward == ""
IF ! ISCHARACTER( cForward ) .OR. cForward == ""
cForward := NIL
ENDIF
IF !ISCHARACTER( cTrailing ) .OR. cTrailing == ""
IF ! ISCHARACTER( cTrailing ) .OR. cTrailing == ""
cTrailing := NIL
ENDIF
@@ -90,7 +91,7 @@ FUNCTION SCREENMARK( cSearch, xAttr, lUpperLower, lAll, cForward, cTrailing )
SUBSTR( cScreen, nAt, 1 ) $ cForward ) .AND. ;
( nAt == nLast .OR. cTrailing == NIL .OR. ;
SUBSTR( cScreen, nAt + nLen ) $ cTrailing )
lFound := .t.
lFound := .T.
--nAt
nRow := INT( nAt / nCols )
nCol := INT( nAt % nCols )
@@ -108,4 +109,5 @@ FUNCTION SCREENMARK( cSearch, xAttr, lUpperLower, lAll, cForward, cTrailing )
ENDIF
nCount++
ENDDO
RETURN lFound
RETURN lFound

3
harbour/contrib/hbct/showtime.prg
View File

@@ -66,4 +66,5 @@ FUNCTION SHOWTIME( nRow, nCol, lNoSec, cColor, l12, lAmPm )
HB_IDLEDEL( t_hTimer )
t_hTimer := NIL
ENDIF
RETURN ""
RETURN ""