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

2008-04-21 14:48 UTC+0100 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* tests/rto_get.prg
   * tests/rto_tb.prg
     + Added more tests.
     + Enabled object as array results by default.
     + More details for TGet test results.

   * bin/bld_os2.cmd
     ! Fixed lib names. Thanks David.

   * source/rtl/tobject.prg
     * Formatting.

   * source/rtl/tget.prg
     ! Delimiter colors in C5.3 mode made compatible.
     ! ::colorSpec handling in C5.3 mode made compatible 
       for some invalid parameter types.
     ! Fixed handling decimals in :row, :col, :pos 
       methods.
     ! Fixed to compile in C5.2 mode without warning
       (introduced in recent commit).

   * source/rtl/tbrowse.prg
     ! Fixed handling decimals in :nTop, :nBottom, :nLeft, :nRight.
     + Added unfinished XPP method :viewArea()
     + Added untested XPP method :firstScrCol()
     ; Few minor formatting.

   * include/hbextern.ch
   * source/rtl/einstvar.prg
     + Added _eInstVar52() which is the C5.2 compatible version 
       of this function. It also replicates a bug.
     * _eInstVar() renamed to _eInstVar53().
     * _eInstVar() made a stub to call _eInstVar53().

   * source/rtl/checkbox.prg
   * source/rtl/listbox.prg
   * source/rtl/pushbtn.prg
   * source/rtl/radiobtn.prg
   * source/rtl/radiogrp.prg
   * source/rtl/scrollbr.prg
   * source/rtl/symbol.prg
   * source/rtl/teditor.prg
   * source/rtl/tget.prg
   * source/rtl/tget1.prg
   * source/rtl/tgetlist.prg
   * source/rtl/tmenuitm.prg
   * source/rtl/tmenusys.prg
   * source/rtl/tpopup.prg
   * source/rtl/ttopbar.prg
     * Formatting (EXPORT: -> EXPORTED:)

   * contrib/hbtip/thtml.prg
   * contrib/hbtip/ftpcln.prg
     ! Fixed to work regardless of SET EXACT setting.
     ; NOTE: I'd suggest an optional compiler warning 
             to detect plain "=" usage. It's bad practice 
             in most cases.

   TODO: make_os2_gcc.cmd -> make_gcc_os2.cmd
   TODO: TGET test case for my vtgetlst problem.
   TODO: TGET fix for the above.
   TODO: _eInstVar() -> _eInstVar53()
This commit is contained in:
Viktor Szakats
2008-04-21 12:56:13 +00:00
parent 317fb99c32
commit b007d20e6b
24 changed files with 311 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files

59
harbour/ChangeLog
View File

@@ -8,6 +8,65 @@
2008-12-31 13:59 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2008-04-21 14:48 UTC+0100 Viktor Szakats (harbour.01 syenar hu)
* tests/rto_get.prg
* tests/rto_tb.prg
+ Added more tests.
+ Enabled object as array results by default.
+ More details for TGet test results.
* bin/bld_os2.cmd
! Fixed lib names. Thanks David.
* source/rtl/tobject.prg
* Formatting.
* source/rtl/tget.prg
! Delimiter colors in C5.3 mode made compatible.
! ::colorSpec handling in C5.3 mode made compatible
for some invalid parameter types.
! Fixed handling decimals in :row, :col, :pos
methods.
! Fixed to compile in C5.2 mode without warning
(introduced in recent commit).
* source/rtl/tbrowse.prg
! Fixed handling decimals in :nTop, :nBottom, :nLeft, :nRight.
+ Added unfinished XPP method :viewArea()
+ Added untested XPP method :firstScrCol()
; Few minor formatting.
* include/hbextern.ch
* source/rtl/einstvar.prg
+ Added _eInstVar52() which is the C5.2 compatible version
of this function. It also replicates a bug.
* _eInstVar() renamed to _eInstVar53().
* _eInstVar() made a stub to call _eInstVar53().
* source/rtl/checkbox.prg
* source/rtl/listbox.prg
* source/rtl/pushbtn.prg
* source/rtl/radiobtn.prg
* source/rtl/radiogrp.prg
* source/rtl/scrollbr.prg
* source/rtl/symbol.prg
* source/rtl/teditor.prg
* source/rtl/tget.prg
* source/rtl/tget1.prg
* source/rtl/tgetlist.prg
* source/rtl/tmenuitm.prg
* source/rtl/tmenusys.prg
* source/rtl/tpopup.prg
* source/rtl/ttopbar.prg
* Formatting (EXPORT: -> EXPORTED:)
* contrib/hbtip/thtml.prg
* contrib/hbtip/ftpcln.prg
! Fixed to work regardless of SET EXACT setting.
; NOTE: I'd suggest an optional compiler warning
to detect plain "=" usage. It's bad practice
in most cases.
2008-04-20 13:25 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/source/rtl/tobject.prg
! fixed the problem with SET EXACT ON I introduced recently by mistake

4
harbour/bin/bld_os2.cmd
View File

@@ -70,8 +70,8 @@ if "%HB_INC_INSTALL%" == "" set HB_INC_INSTALL=..\include\
set _HB_GT_LIB=%HB_GT_LIB%
if "%_HB_GT_LIB%" == "" set _HB_GT_LIB=gtos2
if "%HB_COMPILER%" == "gcc" gcc %1.c %CFLAGS% -I%HB_INC_INSTALL% -L%HB_LIB_INSTALL% -ldebug -lvm -lrtl -l%_HB_GT_LIB% -llang -lrdd -lrtl -lvm -lmacro -lpp -ldbfntx -ldbfcdx -ldbffpt -lhbsix -lhsx -lcommon -lrtl -lvm
if "%HB_COMPILER%" == "icc" icc /Gs+ /W2 /Se /Sd+ /Ti+ /C- /Tp %CFLAGS% -I%HB_INC_INSTALL% %1.c %HB_LIB_INSTALL%\debug.lib %HB_LIB_INSTALL%\vm.lib %HB_LIB_INSTALL%\rtl.lib %HB_LIB_INSTALL%\%_HB_GT_LIB%.lib %HB_LIB_INSTALL%\lang.lib %HB_LIB_INSTALL%\rdd.lib %HB_LIB_INSTALL%\rtl.lib %HB_LIB_INSTALL%\vm.lib %HB_LIB_INSTALL%\macro.lib %HB_LIB_INSTALL%\pp.lib %HB_LIB_INSTALL%\dbfntx.lib %HB_LIB_INSTALL%\dbfcdx.lib %HB_LIB_INSTALL%\common.lib
if "%HB_COMPILER%" == "gcc" gcc %1.c %CFLAGS% -I%HB_INC_INSTALL% -L%HB_LIB_INSTALL% -lhbcpage -lhbdebug -lhbvm -lhbrtl -l%_HB_GT_LIB% -lhblang -lhbrdd -lhbrtl -lhbvm -lhbmacro -lhbpp -lrddfpt -lrddntx -lrddcdx -lhbsix -lhbcommon
if "%HB_COMPILER%" == "icc" icc /Gs+ /W2 /Se /Sd+ /Ti+ /C- /Tp %CFLAGS% -I%HB_INC_INSTALL% %1.c %HB_LIB_INSTALL%\hbcpage.lib %HB_LIB_INSTALL%\hbdebug.lib %HB_LIB_INSTALL%\hbvm.lib %HB_LIB_INSTALL%\hbrtl.lib %HB_LIB_INSTALL%\%_HB_GT_LIB%.lib %HB_LIB_INSTALL%\hblang.lib %HB_LIB_INSTALL%\hbrdd.lib %HB_LIB_INSTALL%\hbrtl.lib %HB_LIB_INSTALL%\hbvm.lib %HB_LIB_INSTALL%\hbmacro.lib %HB_LIB_INSTALL%\hbpp.lib %HB_LIB_INSTALL%\rddfpt.lib %HB_LIB_INSTALL%\rddntx.lib %HB_LIB_INSTALL%\rddcdx.lib %HB_LIB_INSTALL%\hbsix.lib %HB_LIB_INSTALL%\hbcommon.lib
goto END
:CLEANUP

14
harbour/contrib/hbtip/ftpcln.prg
View File

@@ -329,7 +329,7 @@ METHOD ScanLength() CLASS tIPClientFTP
LOCAL aBytes
aBytes := HB_Regex( ::RegBytes, ::cReply )
IF .not. Empty(aBytes)
::nLength = Val( aBytes[2] )
::nLength := Val( aBytes[2] )
ENDIF
RETURN .T.
@@ -420,11 +420,11 @@ METHOD UserCommand( cCommand, lPasv, lReadPort, lGetReply ) CLASS tIPClientFTP
::InetSendAll( ::SocketCon, cCommand )
if lReadPort
lReadPort = ::ReadAuxPort()
lReadPort := ::ReadAuxPort()
endif
if lGetReply
lGetReply = ::GetReply()
lGetReply := ::GetReply()
endif
RETURN .t.
@@ -517,7 +517,7 @@ METHOD Read( nLen ) CLASS tIPClientFTP
IF .not. ::CWD( ::oUrl:cPath )
::bEof = .T. // no data for this transaction
::bEof := .T. // no data for this transaction
RETURN .F.
ENDIF
@@ -532,7 +532,7 @@ METHOD Read( nLen ) CLASS tIPClientFTP
IF .not. ::Retr( ::oUrl:cFile )
::bEof = .T. // no data for this transaction
::bEof := .T. // no data for this transaction
RETURN .F.
ENDIF
@@ -761,7 +761,7 @@ METHOD DownLoadFile( cLocalFile, cRemoteFile ) CLASS tIPClientFTP
IF ! ::bInitialized
IF ! Empty( ::oUrl:cPath ) .AND. ! ::CWD( ::oUrl:cPath )
::bEof = .T. // no data for this transaction
::bEof := .T. // no data for this transaction
RETURN .F.
ENDIF
@@ -770,7 +770,7 @@ METHOD DownLoadFile( cLocalFile, cRemoteFile ) CLASS tIPClientFTP
ENDIF
IF ! ::Retr( ::oUrl:cFile )
::bEof = .T. // no data for this transaction
::bEof := .T. // no data for this transaction
RETURN .F.
ENDIF

2
harbour/contrib/hbtip/thtml.prg
View File

@@ -1240,7 +1240,7 @@ METHOD getAttributes() CLASS THtmlNode
// Tag has no valid attributes
RETURN NIL
ELSEIF ::htmlTagName = "!"
ELSEIF Left( ::htmlTagName, 1 ) == "!"
// <!DOCTYPE > and <!-- comments --> have no HTML attributes
RETURN ::htmlAttributes

2
harbour/include/hbextern.ch
View File

@@ -611,6 +611,8 @@ EXTERNAL __INPUT
EXTERNAL __NONOALERT
EXTERNAL __QQPUB
EXTERNAL _EINSTVAR
EXTERNAL _EINSTVAR52
EXTERNAL _EINSTVAR53
EXTERNAL _NATMSGVER
EXTERNAL _NATSORTVER
EXTERNAL DBGSHADOW

2
harbour/source/rtl/checkbox.prg
View File

@@ -68,7 +68,7 @@
CREATE CLASS CHECKBOX FUNCTION HBCheckBox
EXPORT:
EXPORTED:
VAR cargo

48
harbour/source/rtl/einstvar.prg
View File

@@ -59,9 +59,12 @@
validation codeblock. In other words, in case of _eInstVar()
Harbour is compatible with CA-Cl*pper 5.3, not with 5.2. */
FUNCTION _eInstVar( ... )
RETURN _eInstVar53( ... )
/* NOTE: In CA-Cl*pper 5.2/5.3 the cMethod argument seems to be ignored. */
FUNCTION _eInstVar( oVar, cMethod, xValue, cType, nSubCode, bValid )
FUNCTION _eInstVar53( oVar, cMethod, xValue, cType, nSubCode, bValid )
LOCAL oError
@@ -72,7 +75,48 @@ FUNCTION _eInstVar( oVar, cMethod, xValue, cType, nSubCode, bValid )
oError:gencode := 1
oError:severity := 2
oError:cansubstitute := .T.
oError:subsystem := oVar:classname
oError:subsystem := oVar:className
#ifdef HB_C52_STRICT
HB_SYMBOL_UNUSED( cMethod )
#else
oError:operation := cMethod
#endif
oError:subcode := nSubCode
oError:args := { xValue }
xValue := EVAL( ERRORBLOCK(), oError )
IF VALTYPE( xValue ) != cType
__errInHandler()
ENDIF
ENDIF
RETURN xValue
FUNCTION _eInstVar52( oVar, cMethod, xValue, cType, nSubCode, xMin, xMax )
LOCAL oError
LOCAL lError
IF VALTYPE( xValue ) == cType
lError := .F.
IF xMin != NIL
lError := !( xValue >= xMin )
ENDIF
/* NOTE: In CA-Cl*pper 5.2, xMin validation result is
ignored when xMax != NIL. Harbour is doing the same. */
IF xMax != NIL
lError := !( xValue <= xMax )
ENDIF
ELSE
lError := .T.
ENDIF
IF lError
oError := ErrorNew()
oError:description := HB_LANGERRMSG( 1 )
oError:gencode := 1
oError:severity := 2
oError:cansubstitute := .T.
oError:subsystem := oVar:className
#ifdef HB_C52_STRICT
HB_SYMBOL_UNUSED( cMethod )
#else

2
harbour/source/rtl/listbox.prg
View File

@@ -75,7 +75,7 @@
CREATE CLASS LISTBOX FUNCTION HBListBox
EXPORT:
EXPORTED:
VAR cargo

2
harbour/source/rtl/pushbtn.prg
View File

@@ -68,7 +68,7 @@
CREATE CLASS PUSHBUTTON FUNCTION HBPushButton
EXPORT:
EXPORTED:
VAR cargo /* NOTE: CA-Clipper 5.3 has a bug, where this var cannot be assigned NIL. */

2
harbour/source/rtl/radiobtn.prg
View File

@@ -67,7 +67,7 @@
CREATE CLASS RADIOBUTTN FUNCTION HBRadioButton
EXPORT:
EXPORTED:
VAR cargo /* NOTE: CA-Clipper 5.3 has a bug, where this var is filled with NIL everytime its value is read ( cargo := o:cargo ). */

2
harbour/source/rtl/radiogrp.prg
View File

@@ -68,7 +68,7 @@
CREATE CLASS RADIOGROUP FUNCTION HBRadioGroup
EXPORT:
EXPORTED:
VAR cargo

2
harbour/source/rtl/scrollbr.prg
View File

@@ -67,7 +67,7 @@
CREATE CLASS SCROLLBAR FUNCTION HBScrollBar
EXPORT:
EXPORTED:
VAR cargo

2
harbour/source/rtl/symbol.prg
View File

@@ -54,7 +54,7 @@
CREATE CLASS Symbol
EXPORT:
EXPORTED:
METHOD New( cSymName ) // Constructor. cSymName may already exists or not
METHOD name() // retrieves the symbol name

89
harbour/source/rtl/tbrowse.prg
View File

@@ -54,13 +54,14 @@
#define HB_CLS_NOTOBJECT
#include "common.ch"
#include "hbclass.ch"
#include "button.ch"
#include "color.ch"
#include "common.ch"
#include "error.ch"
#include "inkey.ch"
#include "setcurs.ch"
#include "button.ch"
#include "tbrowse.ch"
/* HB_BRW_STATICMOUSE controls if mouse position is static
@@ -107,6 +108,11 @@
#define _TBR_CONF_COLUMNS 2
#define _TBR_CONF_ALL 3
/* Footing/heading line separator. */
#define _TBR_CHR_LINEDELIMITER ";"
#define _TBR_COORD( n ) Int( n )
/* NOTE: In CA-Cl*pper TBROWSE class does not inherit from any other classes
and there is no public class function like TBrowse(). There is
in XPP though. */
@@ -123,10 +129,10 @@ CREATE CLASS TBrowse
VAR cargo AS USUAL EXPORTED // 01. User-definable variable
HIDDEN:
VAR n_Top AS INTEGER INIT 0 // 02. Top row number for the TBrowse display
VAR n_Left AS INTEGER INIT 0 // 03. Leftmost column for the TBrowse display
VAR n_Bottom AS INTEGER INIT 0 // 04. Bottom row number for the TBrowse display
VAR n_Right AS INTEGER INIT 0 // 05. Rightmost column for the TBrowse display
VAR n_Top AS NUMERIC INIT 0 // 02. Top row number for the TBrowse display
VAR n_Left AS NUMERIC INIT 0 // 03. Leftmost column for the TBrowse display
VAR n_Bottom AS NUMERIC INIT 0 // 04. Bottom row number for the TBrowse display
VAR n_Right AS NUMERIC INIT 0 // 05. Rightmost column for the TBrowse display
VAR columns AS ARRAY INIT {} // 06. Array of TBrowse columns
@@ -249,6 +255,11 @@ EXPORTED:
/* NOTE: nMode is an undocumented parameter in CA-Cl*pper */
METHOD configure( nMode ) // mark that the internal settings of the TBrowse object should be reconfigured
#ifdef HB_COMPAT_XPP
METHOD viewArea() // Xbase++ compatible method
METHOD firstScrCol() // Xbase++ compatible method
#endif
METHOD new( nTop, nLeft, nBottom, nRight ) // constructor, NOTE: This method is a Harbour extension [vszakats]
HIDDEN:
@@ -421,7 +432,7 @@ STATIC FUNCTION _DISP_FHNAME( nRow, nHeight, nLeft, nRight, nType, nColor, aColo
ENDIF
FOR nPos := 1 TO nHeight
DispOutAt( nRow + nPos - 1, nCol, ;
PadR( hb_tokenGet( cName, nPos, ";" ), nWidth ), ;
PadR( hb_tokenGet( cName, nPos, _TBR_CHR_LINEDELIMITER ), nWidth ), ;
IIF( aCol[ _TBCI_DEFCOLOR ][ nColor ] == 0, "N/N", ;
aColors[ aCol[ _TBCI_DEFCOLOR ][ nColor ] ] ) )
NEXT
@@ -970,7 +981,7 @@ STATIC FUNCTION _SETDEFCOLOR( aColData, aColors )
aClr := { aCol[ _TBCI_DEFCOLOR ][ 1 ], aCol[ _TBCI_DEFCOLOR ][ 2 ] }
NEXT
RETURN NIL
RETURN NIL
/* If oCol:colorBlock does not return array length enough then colors
@@ -1399,7 +1410,7 @@ METHOD doConfigure() CLASS TBROWSE
ENDIF
NEXT
nHeight := MAx( ::n_Bottom - ::n_Top, 0 )
nHeight := Max( _TBR_COORD( ::n_Bottom ) - _TBR_COORD( ::n_Top ), 0 )
IF lHeadSep .AND. nHeight > 0
--nHeight
ELSE
@@ -1427,7 +1438,7 @@ METHOD doConfigure() CLASS TBROWSE
/* update headings to maximum size and missing head/foot separators */
FOR EACH aCol IN ::aColData
aCol[ _TBCI_HEADING ] := Replicate( ";", nHeadHeight - hb_TokenCount( aCol[ _TBCI_HEADING ], ";" ) ) + ;
aCol[ _TBCI_HEADING ] := Replicate( _TBR_CHR_LINEDELIMITER, nHeadHeight - hb_TokenCount( aCol[ _TBCI_HEADING ], _TBR_CHR_LINEDELIMITER ) ) + ;
aCol[ _TBCI_HEADING ]
IF lHeadSep .AND. aCol[ _TBCI_HEADSEP ] == ""
aCol[ _TBCI_HEADSEP ] := " "
@@ -1469,7 +1480,7 @@ METHOD doConfigure() CLASS TBROWSE
/* CA-Clipper update visible columns here but without
* colPos repositioning. [druzus]
*/
_SETVISIBLE( ::aColData, ::n_Right - ::n_Left + 1, ;
_SETVISIBLE( ::aColData, _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1, ;
@::nFrozen, @::nLeftVisible, @::nRightVisible )
::nLastPos := 0
@@ -1517,12 +1528,12 @@ STATIC FUNCTION _DECODE_FH( cName, nHeight, nWidth )
/* When last character of heading/footing is ';' then CA-Cl*pper
* does not calculate it as separator
*/
IF Right( cName, 1 ) == ";"
IF Right( cName, 1 ) == _TBR_CHR_LINEDELIMITER
cName := Left( cName, Len( cName ) - 1 )
ENDIF
nHeight := hb_TokenCount( cName, ";" )
nHeight := hb_TokenCount( cName, _TBR_CHR_LINEDELIMITER )
FOR i := 1 TO nHeight
nWidth := Max( nWidth, Len( hb_TokenGet( cName, i, ";" ) ) )
nWidth := Max( nWidth, Len( hb_TokenGet( cName, i, _TBR_CHR_LINEDELIMITER ) ) )
NEXT
ENDIF
@@ -1725,7 +1736,7 @@ METHOD setVisible() CLASS TBROWSE
lFrames := .F.
nColumns := Len( ::aColData )
nWidth := ::n_Right - ::n_Left + 1
nWidth := _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1
nColPos := ::nColPos
IF nColPos > nColumns
@@ -1769,7 +1780,7 @@ METHOD setVisible() CLASS TBROWSE
#endif
/* update column size and positions on the screen */
nLeft := ::n_Left
nLeft := _TBR_COORD( ::n_Left )
lFirst := .T.
FOR nCol := 1 TO ::nRightVisible
aCol := ::aColData[ nCol ]
@@ -1784,7 +1795,7 @@ METHOD setVisible() CLASS TBROWSE
ELSE
nLeft += aCol[ _TBCI_SEPWIDTH ]
ENDIF
nLast := IIF( nCol == ::nRightVisible, ::n_Right - nLeft + 1, 0 )
nLast := IIF( nCol == ::nRightVisible, _TBR_COORD( ::n_Right ) - nLeft + 1, 0 )
IF aCol[ _TBCI_COLPOS ] != nColPos .OR. ;
aCol[ _TBCI_FROZENSPACE ] != nFrozen .OR. ;
@@ -1832,8 +1843,8 @@ METHOD hiLite() CLASS TBROWSE
IF ::setCursorPos()
IF ( cValue := ::cellValue( ::nRowPos, ::nColPos ) ) != NIL
cColor := ::colorValue( ::cellColor( ::nRowPos, ::nColPos )[ _TBC_CLR_SELECTED ] )
IF ::n_Col + Len( cValue ) > ::n_Right
cValue := Left( cValue, ::n_Right - ::n_Col + 1 )
IF ::n_Col + Len( cValue ) > _TBR_COORD( ::n_Right )
cValue := Left( cValue, _TBR_COORD( ::n_Right ) - ::n_Col + 1 )
ENDIF
DispOut( cValue, cColor )
SetPos( ::n_Row, ::n_Col )
@@ -1859,8 +1870,8 @@ METHOD deHilite() CLASS TBROWSE
IF ::setCursorPos()
IF ( cValue := ::cellValue( ::nRowPos, ::nColPos ) ) != NIL
cColor := ::colorValue( ::cellColor( ::nRowPos, ::nColPos )[ _TBC_CLR_STANDARD ] )
IF ::n_Col + Len( cValue ) > ::n_Right
cValue := Left( cValue, ::n_Right - ::n_Col + 1 )
IF ::n_Col + Len( cValue ) > _TBR_COORD( ::n_Right )
cValue := Left( cValue, _TBR_COORD( ::n_Right ) - ::n_Col + 1 )
ENDIF
DispOut( cValue, cColor )
SetPos( ::n_Row, ::n_Col )
@@ -1909,7 +1920,7 @@ METHOD freeze( nColumns ) CLASS TBROWSE
IF ISNUMBER( nColumns )
nCols := Int( nColumns )
IF _MAXFREEZE( nCols, ::aColData, ::n_Right - ::n_Left + 1 ) == nCols
IF _MAXFREEZE( nCols, ::aColData, _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1 ) == nCols
::nFrozen := nCols
::lFrames := .T.
@@ -1917,7 +1928,7 @@ METHOD freeze( nColumns ) CLASS TBROWSE
/* CA-Clipper update visible columns here but without
* colPos repositioning. [druzus]
*/
_SETVISIBLE( ::aColData, ::n_Right - ::n_Left + 1, ;
_SETVISIBLE( ::aColData, _TBR_COORD( ::n_Right ) - _TBR_COORD( ::n_Left ) + 1, ;
@::nFrozen, @::nLeftVisible, @::nRightVisible )
ENDIF
/* NOTE: CA-Cl*pper compatible behaviour. [vszakats] */
@@ -1951,7 +1962,7 @@ METHOD rowCount() CLASS TBROWSE
::doConfigure()
ENDIF
nRows := ::n_Bottom - ::n_Top + 1 - ;
nRows := _TBR_COORD( ::n_Bottom ) - _TBR_COORD( ::n_Top ) + 1 - ;
::nHeadHeight - IIF( ::lHeadSep, 1, 0 ) - ;
::nFootHeight - IIF( ::lFootSep, 1, 0 )
@@ -2133,7 +2144,7 @@ METHOD rightVisible() CLASS TBROWSE
/* Adds a TBColumn object to the TBrowse object */
METHOD addColumn( oCol ) CLASS TBROWSE
/* NOTE: CA-Cl*pper does not check at all on the parameters. */
/* NOTE: CA-Cl*pper doesn't check the parameters. */
AAdd( ::columns, oCol )
::configure( _TBR_CONF_COLUMNS )
@@ -2146,7 +2157,7 @@ METHOD delColumn( nColumn ) CLASS TBROWSE
LOCAL oCol
/* NOTE: CA-Cl*pper does not check at all on the parameters. */
/* NOTE: CA-Cl*pper doesn't check the parameters. */
#ifndef HB_C52_STRICT
IF nColumn >= 1 .AND. nColumn <= ::colCount
#else
@@ -2164,7 +2175,7 @@ METHOD delColumn( nColumn ) CLASS TBROWSE
/* Insert a column object in a browse */
METHOD insColumn( nColumn, oCol ) CLASS TBROWSE
/* NOTE: CA-Cl*pper does not check at all on the parameters. */
/* NOTE: CA-Cl*pper doesn't check the parameters. */
#ifndef HB_C52_STRICT
IF nColumn >= 1 .AND. nColumn <= ::colCount + 1
#else
@@ -2365,6 +2376,30 @@ METHOD nRight( nRight ) CLASS TBROWSE
RETURN ::n_Right
#ifdef HB_COMPAT_XPP
METHOD viewArea() CLASS TBROWSE
// TOFIX
RETURN { ::n_Top + ::nHeadHeight + iif( ::lHeadSep, 1, 0 ),;
::n_Left,;
::n_Bottom - ::nFootHeight - iif( ::lFootSep, 1, 0 ),;
::n_Right,;
0 /* nFrozenWidth */ }
/* NOTE: Returns the left margin relative column position of the first
non-freezed column. Xbase++ compatible method. */
METHOD firstScrCol() CLASS TBROWSE
// TOFIX
RETURN iif( ::leftVisible == 0, 0, ::aColData[ ::leftVisible ][ _TBCI_COLPOS ] )
#endif
#ifdef HB_COMPAT_C53
METHOD nRow() CLASS TBROWSE

2
harbour/source/rtl/teditor.prg
View File

@@ -62,7 +62,7 @@
CREATE CLASS HBEditor
EXPORT:
EXPORTED:
METHOD LoadFile( cFileName ) // Load cFileName into active editor
METHOD LoadText( cString ) // Load cString into active editor

37
harbour/source/rtl/tget.prg
View File

@@ -255,9 +255,9 @@ METHOD display( lForced ) CLASS Get
LOCAL nOldCursor := SetCursor( SC_NONE )
LOCAL cBuffer
LOCAL nDispPos
LOCAL nPos
#ifdef HB_COMPAT_C53
LOCAL nPos
LOCAL cCaption
#endif
@@ -330,8 +330,14 @@ METHOD display( lForced ) CLASS Get
iif( ::lHideInput, PadR( Replicate( SubStr( ::cStyle, 1, 1 ), Len( RTrim( cBuffer ) ) ), ::nDispLen ), SubStr( cBuffer, nDispPos, ::nDispLen ) ),;
hb_ColorIndex( ::cColorSpec, iif( ::hasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ) )
IF Set( _SET_DELIMITERS ) .AND. !::hasFocus
#ifdef HB_COMPAT_C53
DispOutAt( ::nRow, ::nCol - 1, SubStr( Set( _SET_DELIMCHARS ), 1, 1 ), hb_ColorIndex( ::cColorSpec, GET_CLR_UNSELECTED ) )
DispOutAt( ::nRow, ::nCol + ::nDispLen, SubStr( Set( _SET_DELIMCHARS ), 2, 1 ), hb_ColorIndex( ::cColorSpec, GET_CLR_UNSELECTED ) )
#else
/* NOTE: C5.x will use the default color. We're replicating this here. [vszakats] */
DispOutAt( ::nRow, ::nCol - 1, SubStr( Set( _SET_DELIMCHARS ), 1, 1 ) )
DispOutAt( ::nRow, ::nCol + ::nDispLen, SubStr( Set( _SET_DELIMCHARS ), 2, 1 ) )
#endif
ENDIF
ENDIF
@@ -1181,11 +1187,30 @@ METHOD colorSpec( cColorSpec ) CLASS Get
"," + hb_NToColor( iif( ( nClrOth := hb_ColorToN( cClrOth := hb_ColorIndex( cColorSpec, GET_CLR_ENHANCED ) ) ) != -1, nClrOth, nClrUns ) )
#endif
RETURN cColorSpec
/* NOTE: CA-Cl*pper oddity. [vszakats] */
ELSEIF ValType( cColorSpec ) $ "UNDBA"
RETURN NIL
#ifdef HB_COMPAT_C53
/* NOTE: This code doesn't seem to make any sense, but seems to
replicate some original C5.3 behaviour. */
ELSE
IF Set( _SET_INTENSITY )
::cColorSpec := hb_ColorIndex( SetColor(), CLR_UNSELECTED ) + "," +;
hb_ColorIndex( SetColor(), CLR_ENHANCED ) + "," +;
hb_ColorIndex( SetColor(), CLR_STANDARD ) + "," +;
hb_ColorIndex( SetColor(), CLR_BACKGROUND )
ELSE
::cColorSpec := hb_ColorIndex( SetColor(), CLR_STANDARD ) + "," +;
hb_ColorIndex( SetColor(), CLR_STANDARD ) + "," +;
hb_ColorIndex( SetColor(), CLR_STANDARD ) + "," +;
hb_ColorIndex( SetColor(), CLR_STANDARD )
ENDIF
#endif
ENDIF
RETURN iif( ValType( cColorSpec ) $ "UNDBA", NIL, cColorSpec ) /* ; CA-Cl*pper oddity [vszakats] */
RETURN cColorSpec
METHOD pos( nPos ) CLASS Get
@@ -1197,6 +1222,8 @@ METHOD pos( nPos ) CLASS Get
IF ISNUMBER( nPos )
nPos := Int( nPos )
IF ::hasFocus
DO CASE
@@ -1875,7 +1902,7 @@ METHOD minus( lMinus ) CLASS Get
METHOD row( nRow ) CLASS Get
IF PCount() > 0
::nRow := iif( ISNUMBER( nRow ), nRow, 0 )
::nRow := iif( ISNUMBER( nRow ), Int( nRow ), 0 )
ENDIF
RETURN ::nRow
@@ -1886,7 +1913,7 @@ METHOD row( nRow ) CLASS Get
METHOD col( nCol ) CLASS Get
IF PCount() > 0
::nCol := iif( ISNUMBER( nCol ), nCol, 0 )
::nCol := iif( ISNUMBER( nCol ), Int( nCol ), 0 )
ENDIF
RETURN ::nCol

2
harbour/source/rtl/tgetlist.prg
View File

@@ -87,7 +87,7 @@
CREATE CLASS HBGetList
EXPORT:
EXPORTED:
VAR HasFocus AS LOGICAL INIT .F.

2
harbour/source/rtl/tmenuitm.prg
View File

@@ -62,7 +62,7 @@
CREATE CLASS MENUITEM FUNCTION HBMenuItem
EXPORT:
EXPORTED:
VAR cargo

2
harbour/source/rtl/tmenusys.prg
View File

@@ -70,7 +70,7 @@
CREATE CLASS HBMenuSys
EXPORT:
EXPORTED:
METHOD Modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList )
METHOD New( oMenu )

26
harbour/source/rtl/tobject.prg
View File

@@ -86,7 +86,7 @@ FUNCTION HBObject()
/*s_oClass:AddInline( "CLASSNAME" , {| Self | __OBJGETCLSNAME( Self ) }, HB_OO_CLSTP_EXPORTED ) */
/*s_oClass:AddInline( "CLASSH" , {| Self | __CLASSH( Self ) }, HB_OO_CLSTP_EXPORTED ) */
/*s_oClass:AddInline( "CLASSSEL" , {| Self | __CLASSSEL( Self:CLASSH() ) }, HB_OO_CLSTP_EXPORTED ) */
/*s_oClass:AddInline( "EVAL" , {| Self | __EVAL( Self ) }, HB_OO_CLSTP_EXPORTED ) */
/*s_oClass:AddInline( "EVAL" , {| Self | __EVAL( Self ) }, HB_OO_CLSTP_EXPORTED ) */
/* xBase++ */
s_oClass:AddInline( "ISDERIVEDFROM" , {| Self, xPar1 | __ObjDerivedFrom( Self, xPar1 ) }, HB_OO_CLSTP_EXPORTED )
@@ -102,11 +102,11 @@ FUNCTION HBObject()
s_oClass:AddInline( "MSGNOTFOUND" , {| Self, cMsg | ::Error( "Message not found", __OBJGETCLSNAME( Self ), cMsg, IIF( Left( cMsg, 1 ) == "_", 1005, 1004 ) ) }, HB_OO_CLSTP_EXPORTED )
/*s_oClass:AddMultiData(,,HB_OO_CLSTP_EXPORTED,{"CLASS"}, .F. )*/
/*s_oClass:AddMultiData( , , HB_OO_CLSTP_EXPORTED, { "CLASS" }, .F. ) */
/*s_oClass:AddInline( "ADDMETHOD" , { | Self, cMeth, pFunc, nScopeMeth | __clsAddMsg( __CLASSH( Self ) , cMeth , pFunc ,HB_OO_MSG_METHOD , NIL, iif(nScopeMeth==NIL,1,nScopeMeth) ) }, HB_OO_CLSTP_EXPORTED ) */
/*s_oClass:AddInline( "ADDVAR" , { | Self, cVAR, nScopeMeth, uiData , hClass | __clsAddMsg( hClass:=__CLASSH( Self ) , cVar , uidata := __CLS_INCDATA(hClass) , HB_OO_MSG_ACCESS, NIL , iif(nScopeMeth==NIL,1,nScopeMeth) ) , ; */
/* __clsAddMsg( hClass , "_"+cVar , uiData , HB_OO_MSG_ASSIGN, NIL , iif(nScopeMeth==NIL,1,nScopeMeth) ) }, HB_OO_CLSTP_EXPORTED ) */
/*s_oClass:AddInline( "ADDMETHOD" , { | Self, cMeth, pFunc, nScopeMeth | __clsAddMsg( __CLASSH( Self ) , cMeth , pFunc ,HB_OO_MSG_METHOD , NIL, iif( nScopeMeth == NIL, 1, nScopeMeth ) ) }, HB_OO_CLSTP_EXPORTED ) */
/*s_oClass:AddInline( "ADDVAR" , { | Self, cVAR, nScopeMeth, uiData, hClass | __clsAddMsg( hClass:=__CLASSH( Self ) , cVar , uidata := __CLS_INCDATA( hClass ), HB_OO_MSG_ACCESS, NIL, iif( nScopeMeth == NIL, 1, nScopeMeth ) ) , ; */
/* __clsAddMsg( hClass , "_"+cVar , uiData , HB_OO_MSG_ASSIGN, NIL, iif( nScopeMeth == NIL, 1, nScopeMeth ) ) }, HB_OO_CLSTP_EXPORTED ) */
/* Those one exist within Class(y), so we will probably try to implement it */
@@ -137,7 +137,7 @@ FUNCTION HBObject()
/*s_oClass:AddInline( "badMethod" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */
/* this one exist within VO and seem to be Auto Called when object ran out of scope */
/*s_oClass:AddInline( "Axit" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */
/*s_oClass:AddInline( "Axit" , {| Self | }, HB_OO_CLSTP_EXPORTED ) */
s_oClass:Create()
@@ -152,16 +152,16 @@ FUNCTION HBObject()
RETURN s_oClass:Instance()
static function HBObject_New( ... )
return QSelf():Init( ... )
STATIC function HBObject_New( ... )
RETURN QSelf():Init( ... )
static function HBObject_Init()
return QSelf()
STATIC FUNCTION HBObject_Init()
RETURN QSelf()
static function HBObject_Dftonerror( ... )
return QSelf():MSGNOTFOUND( __GetMessage(), ... )
STATIC FUNCTION HBObject_Dftonerror( ... )
RETURN QSelf():MSGNOTFOUND( __GetMessage(), ... )
static function HBObject_Error( cDesc, cClass, cMsg, nCode )
STATIC FUNCTION HBObject_Error( cDesc, cClass, cMsg, nCode )
DEFAULT nCode TO 1004

2
harbour/source/rtl/tpopup.prg
View File

@@ -68,7 +68,7 @@
CREATE CLASS POPUPMENU FUNCTION HBPopUpMenu
EXPORT:
EXPORTED:
VAR cargo
#ifdef HB_EXTENSION

2
harbour/source/rtl/ttopbar.prg
View File

@@ -64,7 +64,7 @@
CREATE CLASS TOPBARMENU FUNCTION HBTopBarMenu
EXPORT:
EXPORTED:
METHOD addItem( oItem )
METHOD delItem( nPos )

89
harbour/tests/rto_get.prg
View File

@@ -94,7 +94,7 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 )
s_lCallBackStack := "CALLBACKSTACK" $ Upper( cCommandLine )
s_lRTEDetails := "RTEDETAILS" $ Upper( cCommandLine )
s_lObjectDump := "ODUMP" $ Upper( cCommandLine )
s_lObjectDump := !( "NODUMP" $ Upper( cCommandLine ) )
// ;
@@ -250,17 +250,55 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 )
// ; ColorSpec
SetPos( 14, 16 ) ; o := _GET_( nInt01, "nInt01",,, )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := ",N/G" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "," )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,N/N" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,N /N" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,N/ N" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G, N/N" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G, N/N " )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "N/G,hkjhkj" )
o:ColorSpec := "BG/RB,BG/RB" ; TEST_LINE( o:ColorSpec := "n/g,n/bg" )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := NIL )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := .T. )
Set( _SET_INTENSITY, .F. )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := .T. )
Set( _SET_INTENSITY, .T. )
SetColor( "W+/R,G+/BR,RG+/B,BG+/G,N/GR,GR+/BG,B/GR*" )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := .T. )
Set( _SET_INTENSITY, .F. )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := .T. )
Set( _SET_INTENSITY, .T. )
SetColor( "" )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := 100 )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := {} )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "" )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := ",N/G" )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "N/G" )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "," )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "N/G,N/N" )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "N/G,N /N" )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "N/G,N/ N" )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "N/G, N/N" )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "N/G, N/N " )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "N/G,hkjhkj" )
o:ColorSpec := "BG/RB,RG+/B" ; TEST_LINE( o:ColorSpec := "n/g,n/bg" )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := NIL )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := .T. )
Set( _SET_INTENSITY, .F. )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := .T. )
Set( _SET_INTENSITY, .T. )
SetColor( "W+/R,G+/BR,RG+/B,BG+/G,N/GR,GR+/BG,B/GR*" )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := .T. )
Set( _SET_INTENSITY, .F. )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := .T. )
Set( _SET_INTENSITY, .T. )
SetColor( "" )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := 100 )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := {} )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "" )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := ",N/G" )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "N/G" )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "," )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "N/G,N/N" )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "N/G,N /N" )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "N/G,N/ N" )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "N/G, N/N" )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "N/G, N/N " )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "N/G,hkjhkj" )
o:ColorSpec := "BG/RB,RG+/B,N/GR,W+/R" ; TEST_LINE( o:ColorSpec := "n/g,n/bg" )
// ; Pos
@@ -322,6 +360,8 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 )
TGetAssign( 0 )
TGetAssign( 1 )
TGetAssign( 3 )
TGetAssign( 3.3 )
TGetAssign( 3.7 )
TGetAssign( 100 )
TGetAssign( "" )
TGetAssign( "az" )
@@ -944,7 +984,11 @@ PROCEDURE LogGETVars( o, desc, xResult )
#endif
/* Both indexes contain binary trash
(except the first char of [11] which is type. [vszakats] */
#ifdef HB_COMPAT_C53
IF tmp != 8 .AND. tmp != 17
#else
IF tmp != 8 .AND. tmp != 11
#endif
FWrite( s_fhnd, " [ " + Str( tmp, 3 ) + " ] " + XToStrX( o[ tmp ] ) + hb_OSNewLine() )
ENDIF
NEXT
@@ -985,13 +1029,26 @@ FUNCTION XToStr( xValue )
CASE cType == "L" ; RETURN iif( xValue, ".T.", ".F." )
CASE cType == "O" ; RETURN xValue:className() + " Object"
CASE cType == "U" ; RETURN "NIL"
CASE cType == "B" ; RETURN '{||...}'
CASE cType == "A" ; RETURN '{.[' + LTrim( Str( Len( xValue ) ) ) + '].}'
CASE cType == "B" ; RETURN '{||...} -> ' + XToStr( Eval( xValue ) )
CASE cType == "A" ; RETURN '{ ' + ArrayToList( xValue ) + ' }'
CASE cType == "M" ; RETURN 'M:"' + xValue + '"'
ENDCASE
RETURN ""
FUNCTION ArrayToList( a )
LOCAL tmp
LOCAL cString := ""
FOR tmp := 1 TO Len( a )
cString += XToStr( a[ tmp ] )
IF tmp < Len( a )
cString += ", "
ENDIF
NEXT
RETURN cString
FUNCTION XToStrE( xValue )
LOCAL cType := ValType( xValue )
@@ -1011,8 +1068,8 @@ FUNCTION XToStrE( xValue )
CASE cType == "L" ; RETURN iif( xValue, ".T.", ".F." )
CASE cType == "O" ; RETURN xValue:className() + " Object"
CASE cType == "U" ; RETURN "NIL"
CASE cType == "B" ; RETURN '{||...}'
CASE cType == "A" ; RETURN '{.[' + LTrim( Str( Len( xValue ) ) ) + '].}'
CASE cType == "B" ; RETURN '{||...} -> ' + XToStr( Eval( xValue ) )
CASE cType == "A" ; RETURN '{ ' + ArrayToList( xValue ) + ' }'
CASE cType == "M" ; RETURN 'M:' + xValue
ENDCASE

2
harbour/tests/rto_tb.prg
View File

@@ -104,7 +104,7 @@ FUNCTION Main( cArg01, cArg02, cArg03, cArg04 )
s_lCallBackStack := "CALLBACKSTACK" $ Upper( cCommandLine )
s_lRTEDetails := "RTEDETAILS" $ Upper( cCommandLine )
s_lIgnoreErrOp := "IGNERROP" $ Upper( cCommandLine )
s_lObjectDump := "ODUMP" $ Upper( cCommandLine )
s_lObjectDump := !( "NODUMP" $ Upper( cCommandLine ) )
s_lCatchErr := .T.
s_lCheckResult := .F.