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

2007-09-17 13:26 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* tests/rto_get.prg
   * tests/rto_tb.prg
   * source/rtl/gui.prg
   + source/rtl/tbrowsys.prg
   * source/rtl/tmenusys.prg
   * source/rtl/menusys.prg
   * source/rtl/tscalar.prg
   * source/rtl/tbrowse.prg
     + Added missing file from previous commit.
     + Set Id keyword and eol-style to native on newly added files.
This commit is contained in:
Viktor Szakats
2007-09-17 11:27:09 +00:00
parent b2561a13f0
commit b6d6464779
8 changed files with 2162 additions and 1975 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
harbour/ChangeLog
View File

@@ -8,6 +8,18 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-09-17 13:26 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* tests/rto_get.prg
* tests/rto_tb.prg
* source/rtl/gui.prg
+ source/rtl/tbrowsys.prg
* source/rtl/tmenusys.prg
* source/rtl/menusys.prg
* source/rtl/tscalar.prg
* source/rtl/tbrowse.prg
+ Added missing file from previous commit.
+ Set Id keyword and eol-style to native on newly added files.
2007-09-17 12:34 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* source/rtl/tscalar.prg
! Some fixes for previous commit regarding scalar classes.

212
harbour/source/rtl/gui.prg
View File

@@ -1,106 +1,106 @@
/*
* $Id: checkbox.prg 7155 2007-04-14 10:41:54Z vszakats $
*/
/*
* Harbour Project source code:
* GUI helper functions
*
* Copyright 2000 Luiz Rafael Culik <culik@sl.conex.net>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "common.ch"
#ifdef HB_COMPAT_C53
#define LLG_VIDEO_TXT 3
FUNCTION _IsGraphic()
RETURN Set( _SET_VIDEOMODE ) != NIL .AND. ;
Set( _SET_VIDEOMODE ) != 0 .AND. ;
Set( _SET_VIDEOMODE ) != LLG_VIDEO_TXT
FUNCTION _SetVideoMode( nMode )
HB_SYMBOL_UNUSED( nMode )
RETURN 0
FUNCTION _GetNumCol( cColor )
LOCAL nPos
IF ( nPos := At( "/", cColor ) ) > 0
cColor := Left( cColor, nPos - 1 )
ENDIF
IF ( nPos := At( ",", cColor ) ) > 0
cColor := Left( cColor, nPos - 1 )
ENDIF
#ifndef HB_C52_STRICT
cColor := Upper( cColor )
#endif
RETURN AScan( { "B", "G", "BG", "R", "RB", "GR", "W", "N+", "B+", "G+", "BG+", "R+", "RB+", "GR+", "W+" }, {| tmp | tmp == cColor } )
FUNCTION __GUIColor( cColor, nPos )
RETURN hb_ColorIndex( cColor, nPos - 1 )
FUNCTION IsDefColor()
RETURN SetColor() == "W/N,N/W,N/N,N/N,N/W" /* NOTE: Color must match with the one in set.c */
/* Removes the accelerator marker from a caption string */
FUNCTION __Caption( cCaption )
LOCAL nPos
RETURN iif( ( nPos := At( "&", cCaption ) ) > 0, Stuff( cCaption, nPos, 1, "" ), cCaption )
FUNCTION __CapLength( cCaption )
LOCAL nCaptionLen := Len( cCaption )
LOCAL nPos
RETURN iif( ( nPos := At( "&", cCaption ) ) > 0 .AND. nPos < nCaptionLen, nCaptionLen - 1, nCaptionLen )
FUNCTION __CapMetrics( o )
RETURN __CapLength( o:caption ) + iif( o:isPopup(), 3, 2 )
#endif
/*
* $Id$
*/
/*
* Harbour Project source code:
* GUI helper functions
*
* Copyright 2000 Luiz Rafael Culik <culik@sl.conex.net>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "common.ch"
#ifdef HB_COMPAT_C53
#define LLG_VIDEO_TXT 3
FUNCTION _IsGraphic()
RETURN Set( _SET_VIDEOMODE ) != NIL .AND. ;
Set( _SET_VIDEOMODE ) != 0 .AND. ;
Set( _SET_VIDEOMODE ) != LLG_VIDEO_TXT
FUNCTION _SetVideoMode( nMode )
HB_SYMBOL_UNUSED( nMode )
RETURN 0
FUNCTION _GetNumCol( cColor )
LOCAL nPos
IF ( nPos := At( "/", cColor ) ) > 0
cColor := Left( cColor, nPos - 1 )
ENDIF
IF ( nPos := At( ",", cColor ) ) > 0
cColor := Left( cColor, nPos - 1 )
ENDIF
#ifndef HB_C52_STRICT
cColor := Upper( cColor )
#endif
RETURN AScan( { "B", "G", "BG", "R", "RB", "GR", "W", "N+", "B+", "G+", "BG+", "R+", "RB+", "GR+", "W+" }, {| tmp | tmp == cColor } )
FUNCTION __GUIColor( cColor, nPos )
RETURN hb_ColorIndex( cColor, nPos - 1 )
FUNCTION IsDefColor()
RETURN SetColor() == "W/N,N/W,N/N,N/N,N/W" /* NOTE: Color must match with the one in set.c */
/* Removes the accelerator marker from a caption string */
FUNCTION __Caption( cCaption )
LOCAL nPos
RETURN iif( ( nPos := At( "&", cCaption ) ) > 0, Stuff( cCaption, nPos, 1, "" ), cCaption )
FUNCTION __CapLength( cCaption )
LOCAL nCaptionLen := Len( cCaption )
LOCAL nPos
RETURN iif( ( nPos := At( "&", cCaption ) ) > 0 .AND. nPos < nCaptionLen, nCaptionLen - 1, nCaptionLen )
FUNCTION __CapMetrics( o )
RETURN __CapLength( o:caption ) + iif( o:isPopup(), 3, 2 )
#endif

346
harbour/source/rtl/menusys.prg
View File

@@ -1,173 +1,173 @@
/*
* $Id: mssgline.prg 7155 2007-04-14 10:41:54Z vszakats $
*/
/*
* Harbour Project source code:
* MENUSYS parts
*
* Copyright 2002 Larry Sevilla <lsevilla@nddc.edu.ph>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbclass.ch"
#include "common.ch"
#include "getexit.ch"
#include "inkey.ch"
#include "setcurs.ch"
/* NOTE: Harbour doesn't support CA-Cl*pper 5.3 GUI functionality, but
it has all related variables and methods. */
#ifdef HB_COMPAT_C53
/* Standard Menu System Modal handling for Menu Items */
FUNCTION MenuModal( oTopMenu, nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList )
RETURN HBMenuSys():New( oTopMenu ):modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList )
/* Dummy function */
FUNCTION ShowMsg( aMsg, lMode )
HB_SYMBOL_UNUSED( aMsg )
HB_SYMBOL_UNUSED( lMode )
RETURN .F.
/***
*
* ShortCut processing for initial Get or Menu Item.
*
***/
FUNCTION IsShortCut( oMenu, nKey, nID )
LOCAL nItem
LOCAL nTotal
LOCAL nShortCut
LOCAL oItem
LOCAL i
// Test for top menu item not a TopBar Menu:
IF !( oMenu:ClassName() == "TOPBARMENU" )
RETURN IsQuick( oMenu, nKey, @nID )
// Test and assign top menu item shortCut, enabled, and !PopUp:
// Changed by enclosing assignment before ':Enabled':
ELSEIF ( nShortCut := oMenu:getShortCt( nKey ) ) > 0 .AND. ;
( oItem := oMenu:getItem( nShortcut ) ):enabled .AND. ;
!oItem:isPopUp()
oMenu:select( nShortCut )
Eval( oItem:data, oItem )
nID := oItem:ID
RETURN .T.
// Test and assignment for TopBar MenuItem:
ELSEIF nShortCut == 0
nTotal := oMenu:itemCount
nItem := oMenu:current
IF nItem == 0
nItem := 1
ENDIF
// Loop to wrap around through TopMenu from Current Item:
FOR i := 1 TO nTotal
IF ( oItem := oMenu:getItem( nItem ) ):enabled .AND. ;
oItem:isPopUp() .AND. ;
IsQuick( oItem:data, nKey, @nID )
RETURN .T.
ENDIF
IF ++nItem > nTotal
nItem := 1
ENDIF
NEXT
ENDIF
RETURN .F.
/***
*
* Navigates to the next Get or Menu Item from the
* Current if more than one uses the same ShortCut.
*
***/
FUNCTION IsQuick( oMenu, nKey, nID )
LOCAL nItem
LOCAL nTotal
LOCAL nShortCut
LOCAL oItem
IF ( nShortCut := oMenu:getShortCt( nKey ) ) == 0
nTotal := oMenu:itemCount
FOR nItem := 1 TO nTotal
IF ( oItem := oMenu:getItem( nItem ) ):enabled .AND. ;
oItem:isPopUp() .AND. ;
IsQuick( oItem:data, nKey, @nID )
RETURN .T.
ENDIF
NEXT
ELSEIF !( oItem := oMenu:getItem( nShortCut ) ):isPopUp() .AND. oItem:enabled
oMenu:select( nShortCut )
Eval( oItem:data, oItem )
nID := oItem:ID
RETURN .T.
ENDIF
RETURN .F.
#endif
/*
* $Id$
*/
/*
* Harbour Project source code:
* MENUSYS parts
*
* Copyright 2002 Larry Sevilla <lsevilla@nddc.edu.ph>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbclass.ch"
#include "common.ch"
#include "getexit.ch"
#include "inkey.ch"
#include "setcurs.ch"
/* NOTE: Harbour doesn't support CA-Cl*pper 5.3 GUI functionality, but
it has all related variables and methods. */
#ifdef HB_COMPAT_C53
/* Standard Menu System Modal handling for Menu Items */
FUNCTION MenuModal( oTopMenu, nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList )
RETURN HBMenuSys():New( oTopMenu ):modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList )
/* Dummy function */
FUNCTION ShowMsg( aMsg, lMode )
HB_SYMBOL_UNUSED( aMsg )
HB_SYMBOL_UNUSED( lMode )
RETURN .F.
/***
*
* ShortCut processing for initial Get or Menu Item.
*
***/
FUNCTION IsShortCut( oMenu, nKey, nID )
LOCAL nItem
LOCAL nTotal
LOCAL nShortCut
LOCAL oItem
LOCAL i
// Test for top menu item not a TopBar Menu:
IF !( oMenu:ClassName() == "TOPBARMENU" )
RETURN IsQuick( oMenu, nKey, @nID )
// Test and assign top menu item shortCut, enabled, and !PopUp:
// Changed by enclosing assignment before ':Enabled':
ELSEIF ( nShortCut := oMenu:getShortCt( nKey ) ) > 0 .AND. ;
( oItem := oMenu:getItem( nShortcut ) ):enabled .AND. ;
!oItem:isPopUp()
oMenu:select( nShortCut )
Eval( oItem:data, oItem )
nID := oItem:ID
RETURN .T.
// Test and assignment for TopBar MenuItem:
ELSEIF nShortCut == 0
nTotal := oMenu:itemCount
nItem := oMenu:current
IF nItem == 0
nItem := 1
ENDIF
// Loop to wrap around through TopMenu from Current Item:
FOR i := 1 TO nTotal
IF ( oItem := oMenu:getItem( nItem ) ):enabled .AND. ;
oItem:isPopUp() .AND. ;
IsQuick( oItem:data, nKey, @nID )
RETURN .T.
ENDIF
IF ++nItem > nTotal
nItem := 1
ENDIF
NEXT
ENDIF
RETURN .F.
/***
*
* Navigates to the next Get or Menu Item from the
* Current if more than one uses the same ShortCut.
*
***/
FUNCTION IsQuick( oMenu, nKey, nID )
LOCAL nItem
LOCAL nTotal
LOCAL nShortCut
LOCAL oItem
IF ( nShortCut := oMenu:getShortCt( nKey ) ) == 0
nTotal := oMenu:itemCount
FOR nItem := 1 TO nTotal
IF ( oItem := oMenu:getItem( nItem ) ):enabled .AND. ;
oItem:isPopUp() .AND. ;
IsQuick( oItem:data, nKey, @nID )
RETURN .T.
ENDIF
NEXT
ELSEIF !( oItem := oMenu:getItem( nShortCut ) ):isPopUp() .AND. oItem:enabled
oMenu:select( nShortCut )
Eval( oItem:data, oItem )
nID := oItem:ID
RETURN .T.
ENDIF
RETURN .F.
#endif

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

@@ -467,6 +467,8 @@ METHOD addColumn( oCol ) CLASS TBrowse
// Insert a column object in a browse
METHOD insColumn( nPos, oCol ) CLASS TBrowse
/* NOTE: CA-Cl*pper does no checks at all on the parameters. */
if nPos >= 1
::Moved() /* TOFIX: This logic should go inside ::configure() */
@@ -513,21 +515,27 @@ METHOD setColumn( nPos, oCol ) CLASS TBrowse
LOCAL oOldCol
/* NOTE: CA-Cl*pper doesn't check this, but crashes instead. */
if nPos != NIL .AND. oCol != NIL
if nPos >= 1 .and. nPos <= ::nColumns
nPos := _eInstVar( Self, "COLUMN", nPos, "N", 1001 )
oCol := _eInstVar( Self, "COLUMN", oCol, "O", 1001 )
::Moved() /* TOFIX: This logic should go inside ::configure() */
/* NOTE: CA-Cl*pper doesn't check nPos range (and type in C5.3), but crashes instead. */
oOldCol := ::aColumns[ nPos ]
if nPos >= 1 .AND. nPos <= ::nColumns
::aColumns[ nPos ] := oCol
::aColsWidth[ nPos ] := ::SetColumnWidth( oCol )
::aColsPos[ nPos ] := 0
::aColsInfo[ nPos ] := ::InitColumn( oCol, .F. )
::Configure( 2 )
::Moved() /* TOFIX: This logic should go inside ::configure() */
oOldCol := ::aColumns[ nPos ]
::aColumns[ nPos ] := oCol
::aColsWidth[ nPos ] := ::SetColumnWidth( oCol )
::aColsPos[ nPos ] := 0
::aColsInfo[ nPos ] := ::InitColumn( oCol, .F. )
::Configure( 2 )
endif
endif
/* NOTE: CA-Cl*pper 5.2 NG says this will return the previously set

167
harbour/source/rtl/tbrowsys.prg Normal file
View File

@@ -0,0 +1,167 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* TBrowse() CA-Cl*pper 5.3 functions
*
* Copyright 2007 {list of individual authors and e-mail addresses}
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#ifdef HB_COMPAT_C53
#include "button.ch"
#include "common.ch"
#include "tbrowse.ch"
PROCEDURE TBReader( oGet, oGetList, oMenu, aMsg )
IF !ISOBJECT( oGetList )
oGetList := __GetListActive()
ENDIF
IF oGetList != NIL
oGetlist:TBReader( oGet, oMenu, aMsg )
ENDIF
RETURN
FUNCTION TBMouse( oBrowse, nMRow, nMCol )
LOCAL n
IF oBrowse:hitTest( nMRow, nMCol ) == HTCELL
n := oBrowse:mRowPos - oBrowse:rowPos
DO WHILE n < 0
n++
oBrowse:up()
ENDDO
DO WHILE n > 0
n--
oBrowse:down()
ENDDO
n := oBrowse:mColPos - oBrowse:colPos
DO WHILE n < 0
n++
oBrowse:left()
ENDDO
DO WHILE n > 0
n--
oBrowse:right()
ENDDO
RETURN TBR_CONTINUE
ENDIF
RETURN TBR_EXCEPTION
FUNCTION TApplyKey( nKey, oBrowse )
RETURN oBrowse:applyKey( nKey )
FUNCTION TBAddCol()
/* TODO */
RETURN NIL
FUNCTION TBApplyKey()
/* TODO */
RETURN NIL
FUNCTION TBBBlock()
/* TODO */
RETURN NIL
FUNCTION TBClose()
/* TODO */
RETURN NIL
FUNCTION TBCreate()
/* TODO */
RETURN NIL
FUNCTION TBDelCol()
/* TODO */
RETURN NIL
FUNCTION TBDisplay()
/* TODO */
RETURN NIL
FUNCTION TBEditCell()
/* TODO */
RETURN NIL
FUNCTION TBFBlock()
/* TODO */
RETURN NIL
FUNCTION TBGoBot()
/* TODO */
RETURN NIL
FUNCTION TBGoTop()
/* TODO */
RETURN NIL
FUNCTION TBInsCol()
/* TODO */
RETURN NIL
FUNCTION TBModal()
/* TODO */
RETURN NIL
FUNCTION TBSBlock()
/* TODO */
RETURN NIL
FUNCTION TBSkip()
/* TODO */
RETURN NIL
#endif

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

File diff suppressed because it is too large Load Diff

628
harbour/source/rtl/tscalar.prg
View File

@@ -1,314 +1,314 @@
/*
* $Id: scalar.prg 7751 2007-09-15 11:54:39Z vszakats $
*/
/*
* Harbour Project source code:
* Harbour implementation of Class(y) Scalar classes
*
* Copyright 2004 Antonio Linares <alinares@fivetechsoft.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
/* Class(y) documentation is located at:
http://www.clipx.net/ng/classy/ngdebc.php */
#include "hbclass.ch"
/* -------------------------------------------- */
CREATE CLASS ScalarObject FUNCTION HBScalar
METHOD Copy()
METHOD IsScalar()
METHOD AsString()
METHOD AsExpStr()
MESSAGE Become METHOD BecomeErr() // a scalar cannot "become" another object
MESSAGE DeepCopy METHOD Copy()
ENDCLASS
METHOD Copy() CLASS ScalarObject
RETURN Self
METHOD IsScalar() CLASS ScalarObject
RETURN .T.
METHOD AsString() CLASS ScalarObject
SWITCH ValType( Self )
CASE "B" ; RETURN "{ || ... }"
CASE "C" ; RETURN Self
CASE "D" ; RETURN DToC( Self )
CASE "L" ; RETURN iif( Self, ".T.", ".F." )
CASE "N" ; RETURN LTrim( Str( Self ) )
CASE "U" ; RETURN "NIL"
ENDSWITCH
RETURN "Error!"
METHOD AsExpStr() CLASS ScalarObject
SWITCH ValType( Self )
CASE "C" ; RETURN '"' + Self + '"'
CASE "D" ; RETURN 'CToD("' + DToC( Self ) + '")'
ENDSWITCH
RETURN ::AsString()
METHOD BecomeErr() CLASS ScalarObject
// Not implemented yet
// ::error( CSYERR_BECOME, "Message 'become' illegally sent to scalar", ::ClassName() )
RETURN NIL
/* -------------------------------------------- */
CREATE CLASS Array INHERIT HBScalar FUNCTION HBArray
METHOD Init()
METHOD AsString()
METHOD At
METHOD AtPut()
METHOD Add
METHOD AddAll()
METHOD Collect()
METHOD Copy()
METHOD Do()
METHOD DeleteAt()
METHOD InsertAt()
METHOD IndexOf()
METHOD IsScalar()
METHOD Remove()
METHOD Scan()
METHOD _Size() // assignment method
ENDCLASS
METHOD Init( nElements ) CLASS Array
::size := iif( nElements == NIL, 0, nElements )
RETURN Self
METHOD AddAll( aOtherCollection ) CLASS Array
aOtherCollection:Do( {| e | ::Add( e ) } )
RETURN Self
METHOD AsString() CLASS Array
RETURN "{ ... }"
METHOD At( n ) CLASS Array
RETURN Self[ n ]
METHOD AtPut( n, x ) CLASS Array
RETURN Self[ n ] := x
METHOD Add( x ) CLASS Array
AAdd( Self, x )
RETURN .T.
METHOD Collect( b ) CLASS Array
LOCAL i
LOCAL currElem
LOCAL result := {}
LOCAL nElems := Len( Self )
FOR i := 1 to nElems
currElem := Self[ i ]
IF Eval( b, currElem )
AAdd( result, currElem )
ENDIF
NEXT
RETURN result
METHOD Copy() CLASS Array
RETURN ACopy( Self, Array( Len( Self ) ) )
METHOD DeleteAt( n ) CLASS Array
IF n > 0 .AND. n <= Len( Self )
ADel( Self, n )
ASize( Self, Len( Self ) - 1 )
ENDIF
RETURN Self
METHOD InsertAt( n, x ) CLASS Array
IF n > Len( Self )
ASize( Self, n )
Self[ n ] := x
ELSEIF n > 0
ASize( Self, Len( Self ) + 1 )
AIns( Self, n )
Self[ n ] := x
ENDIF
RETURN Self
METHOD IsScalar() CLASS Array
RETURN .T.
METHOD Do( b ) CLASS Array
LOCAL i
FOR i := 1 TO Len( Self )
b:Eval( Self[ i ], i )
NEXT
RETURN Self
METHOD IndexOf( x ) CLASS Array
LOCAL nElems := Len( Self )
LOCAL i
FOR i := 1 TO nElems
IF Self[ i ] == x
RETURN i
ENDIF
NEXT
RETURN 0
METHOD Remove( e ) CLASS Array
::DeleteAt( ::IndexOf( e ) )
RETURN NIL
METHOD Scan( b ) CLASS Array
RETURN AScan( Self, b )
METHOD _Size( newSize ) CLASS Array
ASize( Self, newSize )
RETURN newSize // so that assignment works according to standard rules
/* -------------------------------------------- */
CREATE CLASS Block INHERIT HBScalar FUNCTION HBBlock
METHOD AsString()
ENDCLASS
METHOD AsString() CLASS Block
RETURN "{ || ... }"
/* -------------------------------------------- */
CREATE CLASS Character INHERIT HBScalar FUNCTION HBCharacter
METHOD AsString()
METHOD AsExpStr()
ENDCLASS
METHOD AsString() CLASS Character
RETURN Self
METHOD AsExpStr() CLASS Character
RETURN '"' + Self + '"'
/* -------------------------------------------- */
CREATE CLASS Date INHERIT HBScalar FUNCTION HBDate
METHOD AsString()
METHOD AsExpStr()
ENDCLASS
METHOD AsString() CLASS Date
RETURN DToC( Self )
METHOD AsExpStr() CLASS Date
RETURN 'CToD("' + ::AsString() + '")'
/* -------------------------------------------- */
CREATE CLASS Logical INHERIT HBScalar FUNCTION HBLogical
METHOD AsString()
ENDCLASS
METHOD AsString() CLASS Logical
RETURN iif( Self, ".T.", ".F." )
/* -------------------------------------------- */
CREATE CLASS HBNil INHERIT HBScalar
VAR ClassName INIT "NIL"
METHOD AsString()
ENDCLASS
METHOD AsString() CLASS HBNil
RETURN "NIL"
/* -------------------------------------------- */
CREATE CLASS Numeric INHERIT HBScalar FUNCTION HBNumeric
METHOD AsString()
ENDCLASS
METHOD AsString() CLASS Numeric
RETURN LTrim( Str( Self ) )
/* -------------------------------------------- */
/*
* $Id$
*/
/*
* Harbour Project source code:
* Harbour implementation of Class(y) Scalar classes
*
* Copyright 2004 Antonio Linares <alinares@fivetechsoft.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
/* Class(y) documentation is located at:
http://www.clipx.net/ng/classy/ngdebc.php */
#include "hbclass.ch"
/* -------------------------------------------- */
CREATE CLASS ScalarObject FUNCTION HBScalar
METHOD Copy()
METHOD IsScalar()
METHOD AsString()
METHOD AsExpStr()
MESSAGE Become METHOD BecomeErr() // a scalar cannot "become" another object
MESSAGE DeepCopy METHOD Copy()
ENDCLASS
METHOD Copy() CLASS ScalarObject
RETURN Self
METHOD IsScalar() CLASS ScalarObject
RETURN .T.
METHOD AsString() CLASS ScalarObject
SWITCH ValType( Self )
CASE "B" ; RETURN "{ || ... }"
CASE "C" ; RETURN Self
CASE "D" ; RETURN DToC( Self )
CASE "L" ; RETURN iif( Self, ".T.", ".F." )
CASE "N" ; RETURN LTrim( Str( Self ) )
CASE "U" ; RETURN "NIL"
ENDSWITCH
RETURN "Error!"
METHOD AsExpStr() CLASS ScalarObject
SWITCH ValType( Self )
CASE "C" ; RETURN '"' + Self + '"'
CASE "D" ; RETURN 'CToD("' + DToC( Self ) + '")'
ENDSWITCH
RETURN ::AsString()
METHOD BecomeErr() CLASS ScalarObject
// Not implemented yet
// ::error( CSYERR_BECOME, "Message 'become' illegally sent to scalar", ::ClassName() )
RETURN NIL
/* -------------------------------------------- */
CREATE CLASS Array INHERIT HBScalar FUNCTION HBArray
METHOD Init()
METHOD AsString()
METHOD At
METHOD AtPut()
METHOD Add
METHOD AddAll()
METHOD Collect()
METHOD Copy()
METHOD Do()
METHOD DeleteAt()
METHOD InsertAt()
METHOD IndexOf()
METHOD IsScalar()
METHOD Remove()
METHOD Scan()
METHOD _Size() // assignment method
ENDCLASS
METHOD Init( nElements ) CLASS Array
::size := iif( nElements == NIL, 0, nElements )
RETURN Self
METHOD AddAll( aOtherCollection ) CLASS Array
aOtherCollection:Do( {| e | ::Add( e ) } )
RETURN Self
METHOD AsString() CLASS Array
RETURN "{ ... }"
METHOD At( n ) CLASS Array
RETURN Self[ n ]
METHOD AtPut( n, x ) CLASS Array
RETURN Self[ n ] := x
METHOD Add( x ) CLASS Array
AAdd( Self, x )
RETURN .T.
METHOD Collect( b ) CLASS Array
LOCAL i
LOCAL currElem
LOCAL result := {}
LOCAL nElems := Len( Self )
FOR i := 1 to nElems
currElem := Self[ i ]
IF Eval( b, currElem )
AAdd( result, currElem )
ENDIF
NEXT
RETURN result
METHOD Copy() CLASS Array
RETURN ACopy( Self, Array( Len( Self ) ) )
METHOD DeleteAt( n ) CLASS Array
IF n > 0 .AND. n <= Len( Self )
ADel( Self, n )
ASize( Self, Len( Self ) - 1 )
ENDIF
RETURN Self
METHOD InsertAt( n, x ) CLASS Array
IF n > Len( Self )
ASize( Self, n )
Self[ n ] := x
ELSEIF n > 0
ASize( Self, Len( Self ) + 1 )
AIns( Self, n )
Self[ n ] := x
ENDIF
RETURN Self
METHOD IsScalar() CLASS Array
RETURN .T.
METHOD Do( b ) CLASS Array
LOCAL i
FOR i := 1 TO Len( Self )
b:Eval( Self[ i ], i )
NEXT
RETURN Self
METHOD IndexOf( x ) CLASS Array
LOCAL nElems := Len( Self )
LOCAL i
FOR i := 1 TO nElems
IF Self[ i ] == x
RETURN i
ENDIF
NEXT
RETURN 0
METHOD Remove( e ) CLASS Array
::DeleteAt( ::IndexOf( e ) )
RETURN NIL
METHOD Scan( b ) CLASS Array
RETURN AScan( Self, b )
METHOD _Size( newSize ) CLASS Array
ASize( Self, newSize )
RETURN newSize // so that assignment works according to standard rules
/* -------------------------------------------- */
CREATE CLASS Block INHERIT HBScalar FUNCTION HBBlock
METHOD AsString()
ENDCLASS
METHOD AsString() CLASS Block
RETURN "{ || ... }"
/* -------------------------------------------- */
CREATE CLASS Character INHERIT HBScalar FUNCTION HBCharacter
METHOD AsString()
METHOD AsExpStr()
ENDCLASS
METHOD AsString() CLASS Character
RETURN Self
METHOD AsExpStr() CLASS Character
RETURN '"' + Self + '"'
/* -------------------------------------------- */
CREATE CLASS Date INHERIT HBScalar FUNCTION HBDate
METHOD AsString()
METHOD AsExpStr()
ENDCLASS
METHOD AsString() CLASS Date
RETURN DToC( Self )
METHOD AsExpStr() CLASS Date
RETURN 'CToD("' + ::AsString() + '")'
/* -------------------------------------------- */
CREATE CLASS Logical INHERIT HBScalar FUNCTION HBLogical
METHOD AsString()
ENDCLASS
METHOD AsString() CLASS Logical
RETURN iif( Self, ".T.", ".F." )
/* -------------------------------------------- */
CREATE CLASS HBNil INHERIT HBScalar
VAR ClassName INIT "NIL"
METHOD AsString()
ENDCLASS
METHOD AsString() CLASS HBNil
RETURN "NIL"
/* -------------------------------------------- */
CREATE CLASS Numeric INHERIT HBScalar FUNCTION HBNumeric
METHOD AsString()
ENDCLASS
METHOD AsString() CLASS Numeric
RETURN LTrim( Str( Self ) )
/* -------------------------------------------- */

1420
harbour/tests/rto_tb.prg
View File

File diff suppressed because it is too large Load Diff