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

20000403-19:57 GMT+1 Victor Szakats <info@szelvesz.hu>

Browse Source
This commit is contained in:
Viktor Szakats
2000-04-03 17:56:14 +00:00
parent 3dcb9d2dd8
commit 8b0e8e99b8
8 changed files with 421 additions and 186 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
harbour/ChangeLog
View File

@@ -1,3 +1,26 @@
20000403-19:57 GMT+1 Victor Szakats <info@szelvesz.hu>
+ source/rtl/getlist.prg
+ source/rtl/getsys.prg
+ source/rtl/readvar.prg
* source/rtl/tgetlist.prg
* source/rtl/Makefile
* makefile.bc
* makefile.vc
+ New Harbour internal function __GetListActive() added to provide an
interface between TGETLIST and GETSYS.
+ The active getlist holder moved to a separate file GETLIST.
+ RANGECHECK() function added to GETSYS. Now the namespace of GETLIST is
is equivalent to CA-Cl*pper.
+ READVAR() moved back into separate file.
+ TGetList class separated from the GETSYS procedural (compatibility)
interface. This way it's possible to override the GETSYS, READVAR or
TGETLIST modules at link time just like in CA-Clipper.
* source/rtl/tgetlist.prg
! GetP*Validate() - Fixed.
+ Added lHasFocus data.
20000403-18:25 GMT+1 Victor Szakats <info@szelvesz.hu>
* utils/hbtest/*

24
harbour/makefile.bc
View File

@@ -263,11 +263,14 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\dummy.obj \
$(OBJ_DIR)\errorsys.obj \
$(OBJ_DIR)\fieldbl.obj \
$(OBJ_DIR)\getlist.obj \
$(OBJ_DIR)\getsys.obj \
$(OBJ_DIR)\input.obj \
$(OBJ_DIR)\memvarbl.obj \
$(OBJ_DIR)\menuto.obj \
$(OBJ_DIR)\objfunc.obj \
$(OBJ_DIR)\readkey.obj \
$(OBJ_DIR)\readvar.obj \
$(OBJ_DIR)\setfunc.obj \
$(OBJ_DIR)\setkey.obj \
$(OBJ_DIR)\setta.obj \
@@ -1089,6 +1092,20 @@ $(OBJ_DIR)\fieldbl.obj : $(OBJ_DIR)\fieldbl.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\getlist.c : $(RTL_DIR)\getlist.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
$(OBJ_DIR)\getlist.obj : $(OBJ_DIR)\getlist.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\getsys.c : $(RTL_DIR)\getsys.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
$(OBJ_DIR)\getsys.obj : $(OBJ_DIR)\getsys.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\filesys.obj : $(RTL_DIR)\filesys.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
@@ -1292,6 +1309,13 @@ $(OBJ_DIR)\readkey.obj : $(OBJ_DIR)\readkey.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\readvar.c : $(RTL_DIR)\readvar.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
$(OBJ_DIR)\readvar.obj : $(OBJ_DIR)\readvar.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\replic.obj : $(RTL_DIR)\replic.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,

3
harbour/makefile.vc
View File

@@ -302,11 +302,14 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\dummy.obj \
$(OBJ_DIR)\errorsys.obj \
$(OBJ_DIR)\fieldbl.obj \
$(OBJ_DIR)\getlist.obj \
$(OBJ_DIR)\getsys.obj \
$(OBJ_DIR)\input.obj \
$(OBJ_DIR)\memvarbl.obj \
$(OBJ_DIR)\menuto.obj \
$(OBJ_DIR)\objfunc.obj \
$(OBJ_DIR)\readkey.obj \
$(OBJ_DIR)\readvar.obj \
$(OBJ_DIR)\setfunc.obj \
$(OBJ_DIR)\setkey.obj \
$(OBJ_DIR)\setta.obj \

3
harbour/source/rtl/Makefile
View File

@@ -122,11 +122,14 @@ PRG_SOURCES=\
dummy.prg \
errorsys.prg \
fieldbl.prg \
getlist.prg \
getsys.prg \
input.prg \
memvarbl.prg \
menuto.prg \
objfunc.prg \
readkey.prg \
readvar.prg \
setfunc.prg \
setkey.prg \
setta.prg \

55
harbour/source/rtl/getlist.prg Normal file
View File

@@ -0,0 +1,55 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* GET system active getlist handler for default TGETLIST/GETSYS/READVAR
*
* Copyright 2000 Victor Szakats <info@szelvesz.hu>
* 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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
/* NOTE: Harbour internal function to set and get the active GetList */
STATIC s_oGetListActive
PROCEDURE __GetListSetActive( oGetList )
IF s_oGetListActive != NIL
s_oGetListActive:lHasFocus := .F.
ENDIF
s_oGetListActive := oGetList
s_oGetListActive:lHasFocus := .T.
RETURN
/* NOTE: Using a separate function for maximum speed */
FUNCTION __GetListActive()
RETURN s_oGetListActive

249
harbour/source/rtl/getsys.prg Normal file
View File

@@ -0,0 +1,249 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* GET system module (default)
*
* Copyright 1999 Antonio Linares <alinares@fivetech.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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "common.ch"
FUNCTION ReadModal( GetList, nPos )
LOCAL oGetList
IF Empty( GetList )
SetPos( MaxRow() - 1, 0 )
RETURN .F.
ENDIF
oGetList := TGetList():New( GetList )
oGetList:cReadProcName := ProcName( 1 )
oGetList:nReadProcLine := ProcLine( 1 )
__GetListSetActive( oGetList )
IF ! ( ISNUMBER( nPos ) .AND. nPos > 0 )
oGetList:nPos := oGetList:Settle( 0 )
ENDIF
DO WHILE oGetList:nPos != 0
oGetList:oGet := oGetList:aGetList[ oGetList:nPos ]
oGetList:PostActiveGet()
IF ISBLOCK( oGetList:oGet:Reader )
Eval( oGetList:oGet:Reader, oGetList:oGet )
ELSE
oGetList:Reader()
ENDIF
oGetList:nPos := oGetList:Settle()
ENDDO
SetPos( MaxRow() - 1, 0 )
RETURN oGetList:lUpdated
PROCEDURE GetReader( oGet )
oGet:Reader()
RETURN
FUNCTION GetActive( oGet )
IF __GetListActive() != NIL
IF PCount() > 0
RETURN __GetListActive():GetActive( oGet )
ELSE
RETURN __GetListActive():GetActive()
ENDIF
ENDIF
RETURN NIL
PROCEDURE GetDoSetKey( keyBlock, oGet )
IF __GetListActive() != NIL
IF oGet != NIL
__GetListActive():oGet := oGet
ENDIF
__GetListActive():GetDoSetKey( keyBlock )
ENDIF
RETURN
PROCEDURE GetApplyKey( oGet, nKey )
IF __GetListActive() != NIL
__GetListActive():oGet := oGet
__GetListActive():GetApplyKey( nKey )
ENDIF
RETURN
FUNCTION GetPreValidate( oGet )
IF __GetListActive() != NIL
IF oGet != NIL
__GetListActive():oGet := oGet
ENDIF
RETURN __GetListActive():GetPreValidate()
ENDIF
RETURN .F.
FUNCTION GetPostValidate( oGet )
IF __GetListActive() != NIL
IF oGet != NIL
__GetListActive():oGet := oGet
ENDIF
RETURN __GetListActive():GetPostValidate()
ENDIF
RETURN .F.
FUNCTION ReadExit( lExit )
RETURN Set( _SET_EXIT, lExit )
FUNCTION ReadInsert( lInsert )
RETURN Set( _SET_INSERT, lInsert )
FUNCTION ReadUpdated( lUpdated )
IF __GetListActive() != NIL
IF PCount() > 0
RETURN __GetListActive():ReadUpdated( lUpdated )
ELSE
RETURN __GetListActive():ReadUpdated()
ENDIF
ENDIF
RETURN .F.
FUNCTION Updated()
IF __GetListActive() != NIL
RETURN __GetListActive():lUpdated
ENDIF
RETURN .F.
FUNCTION ReadKill( lKill )
IF __GetListActive() != NIL
IF PCount() > 0
RETURN __GetListActive():KillRead( lKill )
ELSE
RETURN __GetListActive():KillRead()
ENDIF
ENDIF
RETURN .F.
PROCEDURE __KillRead()
IF __GetListActive() != NIL
__GetListActive():KillRead( .T. )
ENDIF
RETURN
PROCEDURE __SetFormat( bFormat )
IF __GetListActive() != NIL
IF ISBLOCK( bFormat )
__GetListActive():SetFormat( bFormat )
ELSE
__GetListActive():SetFormat()
ENDIF
ENDIF
RETURN
FUNCTION ReadFormat( bFormat )
IF __GetListActive() != NIL
IF PCount() > 0
RETURN __GetListActive():SetFormat( bFormat )
ELSE
RETURN __GetListActive():SetFormat()
ENDIF
ENDIF
RETURN NIL
#define SCORE_ROW 0
#define SCORE_COL 60
#define _GET_RANGE_FROM 10
#define _GET_RANGE_TO 11
FUNCTION RangeCheck( oGet, xDummy, xLow, xHigh )
LOCAL xValue
LOCAL cMessage
LOCAL nOldRow, nOldCol
IF !oGet:changed
RETURN .T.
ENDIF
xValue := oGet:varGet()
IF xValue >= xLow .AND. xValue <= xHigh
RETURN .T.
ENDIF
IF Set( _SET_SCOREBOARD )
cMessage := Left( NationMsg( _GET_RANGE_FROM ) + LTrim( hb_ValToStr( xLow ) ) + ;
NationMsg( _GET_RANGE_TO ) + LTrim( hb_ValToStr( xHigh ) ), MaxCol() )
nOldRow := Row()
nOldCol := Col()
DispOutAt( SCORE_ROW, Min( 60, MaxCol() - Len( cMessage ) ), cMessage )
SetPos( nOldRow, nOldCol )
DO WHILE NextKey() == 0
ENDDO
DispOutAt( SCORE_ROW, Min( 60, MaxCol() - Len( cMessage ) ), Space( Len( cMessage ) ) )
SetPos( nOldRow, nOldCol )
ENDIF
RETURN .F.

43
harbour/source/rtl/readvar.prg Normal file
View File

@@ -0,0 +1,43 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* READVAR() function
*
* Copyright 2000 Victor Szakats <info@szelvesz.hu>
* 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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
FUNCTION ReadVar( cNewVarName )
IF __GetListActive() != NIL
RETURN __GetListActive():ReadVar( cNewVarName )
ENDIF
RETURN ""

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

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* GetList Class
* TGetList Class
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
@@ -40,46 +40,10 @@
#include "setcurs.ch"
#define SCORE_ROW 0
#define SCORE_COL 60
#define SCORE_COL 60
#define K_UNDO K_CTRL_U
static s_oGetListActive
function ReadModal( GetList, nPos )
local oGetList
if Empty( GetList )
SetPos( MaxRow() - 1, 0 )
return .f.
endif
oGetList := TGetList():New( GetList )
oGetList:cReadProcName := ProcName( 1 )
oGetList:nReadProcLine := ProcLine( 1 )
s_oGetListActive := oGetList
if ! ( ISNUMBER( nPos ) .and. nPos > 0 )
oGetList:nPos := oGetList:Settle( 0 )
endif
while oGetList:nPos != 0
oGetList:oGet := oGetList:aGetList[ oGetList:nPos ]
oGetList:PostActiveGet()
if ISBLOCK( oGetList:oGet:Reader )
Eval( oGetList:oGet:Reader, oGetList:oGet )
else
oGetList:Reader()
endif
oGetList:nPos := oGetList:Settle()
end
SetPos( MaxRow() - 1, 0 )
return oGetList:lUpdated
CLASS TGetList
DATA aGetList
@@ -93,6 +57,7 @@ CLASS TGetList
DATA oActiveGet
DATA cReadProcName, nReadProcLine
DATA cVarName
DATA lHasFocus
METHOD New( GetList )
METHOD Settle( nPos )
@@ -111,29 +76,34 @@ CLASS TGetList
METHOD ReadUpdated( lUpdated )
METHOD ReadVar( cNewVarName )
METHOD ReadExit( lNew ) INLINE Set( _SET_EXIT, lNew )
METHOD SetFocus() INLINE s_oGetListActive := Self,;
::aGetList[ ::nPos ]:SetFocus()
METHOD SetFocus()
METHOD Updated() INLINE ::lUpdated
ENDCLASS
METHOD New( GetList ) CLASS TGetList
::aGetList := GetList
::lKillRead := .f.
::lBumpTop := .f.
::lBumpBot := .f.
::aGetList := GetList
::lKillRead := .f.
::lBumpTop := .f.
::lBumpBot := .f.
::nLastExitState := 0
::nLastPos := 0
::cReadProcName := ""
::lUpdated := .f.
::nPos := 1
::oGet := GetList[ 1 ]
::nLastPos := 0
::cReadProcName := ""
::lUpdated := .f.
::nPos := 1
::oGet := GetList[ 1 ]
::lHasFocus := .F.
return Self
METHOD SetFocus() CLASS TGetList
__GetListSetActive( Self )
::aGetList[ ::nPos ]:SetFocus()
return Self
METHOD Reader() CLASS TGetList
local oGet := ::oGet
@@ -301,14 +271,6 @@ METHOD GetPreValidate() CLASS TGetList
return lWhen
function GetPreValidate( oGet )
if oGet != nil
s_oGetListActive:oGet := oGet
endif
return s_oGetListActive:GetPreValidate()
METHOD GetPostValidate() CLASS TGetList
local oGet := ::oGet
@@ -350,14 +312,6 @@ METHOD GetPostValidate() CLASS TGetList
return lValid
function GetPostValidate( oGet )
if oGet != nil
s_oGetListActive:oGet := oGet
endif
return s_oGetListActive:GetPostValidate()
METHOD GetDoSetKey( bKeyBlock ) CLASS TGetList
local oGet := ::oGet, lUpdated
@@ -476,18 +430,6 @@ METHOD GetReadVar() CLASS TGetList
return cName
function ReadFormat( bFormat )
if s_oGetListActive != NIL
if PCount() > 0
return s_oGetListActive:SetFormat( bFormat )
else
return s_oGetListActive:SetFormat()
endif
endif
return nil
METHOD SetFormat( bFormat ) CLASS TGetList
local bSavFormat := ::bFormat
@@ -573,110 +515,3 @@ METHOD ReadUpdated( lUpdated ) CLASS TGetList
endif
return lSavUpdated
/* ------------------ Global functions ------------------- */
PROCEDURE GetReader( oGet )
oGet:Reader()
RETURN
FUNCTION GetActive( oGet )
if s_oGetListActive != NIL
if PCount() > 0
RETURN s_oGetListActive:GetActive( oGet )
else
RETURN s_oGetListActive:GetActive()
endif
endif
RETURN NIL
PROCEDURE GetDoSetKey( keyBlock, oGet )
if s_oGetListActive != NIL
if oGet != NIL
s_oGetListActive:oGet := oGet
endif
s_oGetListActive:GetDoSetKey( keyBlock )
endif
RETURN
PROCEDURE GetApplyKey( oGet, nKey )
if s_oGetListActive != NIL
s_oGetListActive:oGet := oGet
s_oGetListActive:GetApplyKey( nKey )
endif
RETURN
FUNCTION ReadVar( cNewVarName )
if s_oGetListActive != NIL
RETURN s_oGetListActive:ReadVar( cNewVarName )
endif
RETURN ""
FUNCTION ReadExit( lExit )
RETURN Set( _SET_EXIT, lExit )
FUNCTION ReadInsert( lInsert )
RETURN Set( _SET_INSERT, lInsert )
FUNCTION ReadUpdated( lUpdated )
if s_oGetListActive != NIL
if PCount() > 0
RETURN s_oGetListActive:ReadUpdated( lUpdated )
else
RETURN s_oGetListActive:ReadUpdated()
endif
endif
RETURN .F.
FUNCTION Updated()
if s_oGetListActive != NIL
RETURN s_oGetListActive:lUpdated
endif
RETURN .F.
FUNCTION ReadKill( lKill )
if s_oGetListActive != NIL
if PCount() > 0
RETURN s_oGetListActive:KillRead( lKill )
else
RETURN s_oGetListActive:KillRead()
endif
endif
RETURN .F.
PROCEDURE __KillRead()
IF s_oGetListActive != NIL
s_oGetListActive:KillRead( .T. )
ENDIF
RETURN
PROCEDURE __SetFormat( bFormat )
if s_oGetListActive != NIL
if ValType( bFormat ) == "B"
s_oGetListActive:SetFormat( bFormat )
else
s_oGetListActive:SetFormat()
endif
endif
RETURN