669 lines
13 KiB
Plaintext
669 lines
13 KiB
Plaintext
/*
|
|
* $Id$
|
|
*/
|
|
|
|
/*
|
|
* Harbour Project source code:
|
|
* GetList Class
|
|
*
|
|
* 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 "hbclass.ch"
|
|
#include "common.ch"
|
|
#include "getexit.ch"
|
|
#include "inkey.ch"
|
|
#include "setcurs.ch"
|
|
|
|
#define SCORE_ROW 0
|
|
#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
|
|
DATA oGet, nPos
|
|
DATA bFormat
|
|
DATA lUpdated
|
|
DATA lKillRead
|
|
DATA lBumpTop, lBumpBot
|
|
DATA nLastExitState
|
|
DATA nLastPos
|
|
DATA oActiveGet
|
|
DATA cReadProcName, nReadProcLine
|
|
DATA cVarName
|
|
|
|
METHOD New( GetList )
|
|
METHOD Settle( nPos )
|
|
METHOD Reader()
|
|
METHOD GetApplyKey( nKey )
|
|
METHOD GetPreValidate()
|
|
METHOD GetPostValidate()
|
|
METHOD GetDoSetKey( bKeyBlock )
|
|
METHOD PostActiveGet()
|
|
METHOD GetReadVar()
|
|
METHOD SetFormat( bFormat )
|
|
METHOD KillRead( lKill )
|
|
METHOD GetActive( oGet )
|
|
METHOD DateMsg()
|
|
METHOD ShowScoreBoard()
|
|
METHOD ReadUpdated( lUpdated )
|
|
METHOD ReadVar( cNewVarName )
|
|
METHOD ReadExit( lNew ) INLINE Set( _SET_EXIT, lNew )
|
|
|
|
METHOD SetFocus() INLINE s_oGetListActive := Self,;
|
|
::aGetList[ ::nPos ]:SetFocus()
|
|
|
|
METHOD Updated() INLINE ::lUpdated
|
|
|
|
ENDCLASS
|
|
|
|
METHOD New( GetList ) CLASS TGetList
|
|
|
|
::aGetList = GetList
|
|
::lKillRead = .f.
|
|
::lBumpTop = .f.
|
|
::lBumpBot = .f.
|
|
::nLastExitState = 0
|
|
::nLastPos = 0
|
|
::cReadProcName = ""
|
|
::lUpdated = .f.
|
|
::nPos = 1
|
|
::oGet = GetList[ 1 ]
|
|
|
|
return Self
|
|
|
|
METHOD Reader() CLASS TGetList
|
|
|
|
local oGet := ::oGet
|
|
|
|
if ::GetPreValidate()
|
|
|
|
oGet:SetFocus()
|
|
|
|
while oGet:ExitState == GE_NOEXIT
|
|
if oGet:typeOut
|
|
oGet:ExitState = GE_ENTER
|
|
endif
|
|
|
|
while oGet:exitState == GE_NOEXIT
|
|
::GetApplyKey( Inkey( 0 ) )
|
|
end
|
|
|
|
if ! ::GetPostValidate()
|
|
oGet:ExitState = GE_NOEXIT
|
|
endif
|
|
end
|
|
|
|
oGet:killFocus()
|
|
endif
|
|
|
|
return nil
|
|
|
|
procedure GetReader( oGet )
|
|
|
|
oGet:Reader()
|
|
|
|
return
|
|
|
|
METHOD GetApplyKey( nKey ) CLASS TGetList
|
|
|
|
local cKey, bKeyBlock, oGet := ::oGet
|
|
|
|
if ! ( ( bKeyBlock := Setkey( nKey ) ) == nil )
|
|
::GetDoSetKey( bKeyBlock )
|
|
return nil
|
|
endif
|
|
|
|
do case
|
|
case nKey == K_UP
|
|
oGet:ExitState = GE_UP
|
|
|
|
case nKey == K_SH_TAB
|
|
oGet:ExitState = GE_UP
|
|
|
|
case nKey == K_DOWN
|
|
oGet:ExitState = GE_DOWN
|
|
|
|
case nKey == K_TAB
|
|
oGet:ExitState = GE_DOWN
|
|
|
|
case nKey == K_ENTER
|
|
oGet:ExitState = GE_ENTER
|
|
|
|
case nKey == K_ESC
|
|
if Set( _SET_ESCAPE )
|
|
oGet:UnDo()
|
|
oGet:ExitState = GE_ESCAPE
|
|
endif
|
|
|
|
case nKey == K_PGUP
|
|
oGet:ExitState = GE_WRITE
|
|
|
|
case nKey == K_PGDN
|
|
oGet:ExitState = GE_WRITE
|
|
|
|
case nKey == K_CTRL_HOME
|
|
oGet:ExitState = GE_TOP
|
|
|
|
#ifdef CTRL_END_SPECIAL
|
|
case nKey == K_CTRL_END
|
|
oGet:ExitState = GE_BOTTOM
|
|
#else
|
|
case nKey == K_CTRL_W
|
|
oGet:ExitState = GE_WRITE
|
|
#endif
|
|
|
|
case nKey == K_INS
|
|
Set( _SET_INSERT, ! Set( _SET_INSERT ) )
|
|
::ShowScoreboard()
|
|
|
|
case nKey == K_UNDO
|
|
oGet:UnDo()
|
|
|
|
case nKey == K_HOME
|
|
oGet:Home()
|
|
|
|
case nKey == K_END
|
|
oGet:End()
|
|
|
|
case nKey == K_RIGHT
|
|
oGet:Right()
|
|
|
|
case nKey == K_LEFT
|
|
oGet:Left()
|
|
|
|
case nKey == K_CTRL_RIGHT
|
|
oGet:WordRight()
|
|
|
|
case nKey == K_CTRL_LEFT
|
|
oGet:WordLeft()
|
|
|
|
case nKey == K_BS
|
|
oGet:BackSpace()
|
|
|
|
case nKey == K_DEL
|
|
oGet:Delete()
|
|
|
|
case nKey == K_CTRL_T
|
|
oGet:DelWordRight()
|
|
|
|
case nKey == K_CTRL_Y
|
|
oGet:DelEnd()
|
|
|
|
case nKey == K_CTRL_BS
|
|
oGet:DelWordLeft()
|
|
|
|
otherwise
|
|
|
|
if nKey >= 32 .and. nKey <= 255
|
|
cKey := Chr( nKey )
|
|
|
|
if oGet:type == "N" .and. ( cKey == "." .or. cKey == "," )
|
|
oGet:ToDecPos()
|
|
else
|
|
if Set( _SET_INSERT )
|
|
oGet:Insert( cKey )
|
|
else
|
|
oGet:OverStrike( cKey )
|
|
endif
|
|
|
|
if oGet:TypeOut
|
|
if Set( _SET_BELL )
|
|
?? Chr( 7 )
|
|
endif
|
|
if ! Set( _SET_CONFIRM )
|
|
oGet:ExitState = GE_ENTER
|
|
endif
|
|
endif
|
|
endif
|
|
endif
|
|
endcase
|
|
|
|
return nil
|
|
|
|
METHOD GetPreValidate() CLASS TGetList
|
|
|
|
local oGet := ::oGet
|
|
local lUpdated, lWhen := .t.
|
|
|
|
if oGet:PreBlock != nil
|
|
lUpdated = ::lUpdated
|
|
lWhen = Eval( oGet:PreBlock, oGet )
|
|
oGet:Display()
|
|
::ShowScoreBoard()
|
|
::lUpdated := lUpdated
|
|
endif
|
|
|
|
if ::lKillRead
|
|
lWhen = .f.
|
|
oGet:ExitState = GE_ESCAPE
|
|
elseif ! lWhen
|
|
oGet:ExitState = GE_WHEN
|
|
else
|
|
oGet:ExitState = GE_NOEXIT
|
|
end
|
|
|
|
return lWhen
|
|
|
|
function GetPreValidate( oGet )
|
|
|
|
if oGet != nil
|
|
s_oGetListActive:oGet = oGet
|
|
endif
|
|
|
|
return s_oGetListActive:GetPreValidate()
|
|
|
|
METHOD GetPostValidate() CLASS TGetList
|
|
|
|
local oGet := ::oGet
|
|
local lUpdated, lValid := .t.
|
|
|
|
if oGet:ExitState == GE_ESCAPE
|
|
return .t.
|
|
endif
|
|
|
|
if oGet:BadDate()
|
|
oGet:SetFocus()
|
|
::DateMsg()
|
|
::ShowScoreboard()
|
|
return .f.
|
|
endif
|
|
|
|
if oGet:Changed
|
|
oGet:Assign()
|
|
::lUpdated = .t.
|
|
endif
|
|
|
|
oGet:Reset()
|
|
|
|
if oGet:PostBlock != nil
|
|
|
|
lUpdated = ::lUpdated
|
|
SetPos( oGet:Row, oGet:Col + Len( oGet:Buffer ) )
|
|
lValid = Eval( oGet:PostBlock, oGet )
|
|
SetPos( oGet:Row, oGet:Col )
|
|
::ShowScoreBoard()
|
|
oGet:UpdateBuffer()
|
|
::lUpdated = lUpdated
|
|
|
|
if ::lKillRead
|
|
oGet:ExitState = GE_ESCAPE
|
|
lValid = .t.
|
|
endif
|
|
endif
|
|
|
|
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
|
|
|
|
if oGet:Changed
|
|
oGet:Assign()
|
|
::lUpdated := .t.
|
|
endif
|
|
|
|
lUpdated = ::lUpdated
|
|
|
|
Eval( bKeyBlock, ::cReadProcName, ::nReadProcLine, ::ReadVar() )
|
|
|
|
::ShowScoreboard()
|
|
oGet:UpdateBuffer()
|
|
|
|
::lUpdated = lUpdated
|
|
|
|
if ::lKillRead
|
|
oGet:ExitState = GE_ESCAPE
|
|
endif
|
|
|
|
return nil
|
|
|
|
PROCEDURE GetDoSetKey( keyBlock, oGet )
|
|
|
|
if oGet != nil .and. s_oGetListActive != nil
|
|
s_oGetListActive:oGet = oGet
|
|
endif
|
|
|
|
if s_oGetListActive != nil
|
|
s_oGetListActive:GetDoSetKey( keyBlock )
|
|
endif
|
|
|
|
return
|
|
|
|
METHOD Settle( nPos ) CLASS TGetList
|
|
|
|
local nExitState
|
|
|
|
if nPos == nil
|
|
nPos = ::nPos
|
|
endif
|
|
|
|
if nPos == 0
|
|
nExitState = GE_DOWN
|
|
else
|
|
nExitState := ::aGetList[ nPos ]:ExitState
|
|
endif
|
|
|
|
if nExitState == GE_ESCAPE .or. nExitState == GE_WRITE
|
|
return 0
|
|
endif
|
|
|
|
if nExitState != GE_WHEN
|
|
::nLastPos = nPos
|
|
::lBumpTop = .f.
|
|
::lBumpBot = .f.
|
|
else
|
|
nExitState := ::nLastExitState
|
|
endif
|
|
|
|
do case
|
|
case nExitState == GE_UP
|
|
nPos--
|
|
|
|
case nExitState == GE_DOWN
|
|
nPos++
|
|
|
|
case nExitState == GE_TOP
|
|
nPos = 1
|
|
::lBumpTop = .T.
|
|
nExitState = GE_DOWN
|
|
|
|
case nExitState == GE_BOTTOM
|
|
nPos = Len( ::aGetList )
|
|
::lBumpBot = .t.
|
|
nExitState = GE_UP
|
|
|
|
case nExitState == GE_ENTER
|
|
nPos++
|
|
endcase
|
|
|
|
if nPos == 0
|
|
if ! ::ReadExit() .and. ! ::lBumpBot
|
|
::lBumpTop = .t.
|
|
nPos = ::nLastPos
|
|
nExitState = GE_DOWN
|
|
endif
|
|
|
|
elseif nPos == Len( ::aGetList ) + 1
|
|
if ! ::ReadExit() .and. nExitState != GE_ENTER .and. ! ::lBumpTop
|
|
::lBumpBot = .t.
|
|
nPos = ::nLastPos
|
|
nExitState = GE_UP
|
|
else
|
|
nPos = 0
|
|
endif
|
|
endif
|
|
|
|
::nLastExitState = nExitState
|
|
|
|
if nPos != 0
|
|
::aGetList[ nPos ]:ExitState := nExitState
|
|
endif
|
|
|
|
return nPos
|
|
|
|
METHOD PostActiveGet() CLASS TGetList
|
|
|
|
::GetActive( ::oGet )
|
|
::ReadVar( ::GetReadVar() )
|
|
::ShowScoreBoard()
|
|
|
|
return nil
|
|
|
|
METHOD GetReadVar() CLASS TGetList
|
|
|
|
local oGet := ::oGet
|
|
local cName := Upper( oGet:Name )
|
|
local n
|
|
|
|
if oGet:Subscript != nil
|
|
for n := 1 TO Len( oGet:Subscript )
|
|
cName += "[" + LTrim( Str( oGet:Subscript[ n ] ) ) + "]"
|
|
next
|
|
end
|
|
|
|
return cName
|
|
|
|
function ReadFormat( bFormat )
|
|
|
|
if PCount() > 0
|
|
return s_oGetListActive:SetFormat( bFormat )
|
|
else
|
|
return s_oGetListActive:SetFormat()
|
|
endif
|
|
|
|
return nil
|
|
|
|
METHOD SetFormat( bFormat ) CLASS TGetList
|
|
|
|
local bSavFormat := ::bFormat
|
|
|
|
::bFormat = bFormat
|
|
|
|
return bSavFormat
|
|
|
|
procedure __SetFormat( bFormat )
|
|
|
|
if s_oGetListActive != nil
|
|
if ValType( bFormat ) == "B"
|
|
s_oGetListActive:SetFormat( bFormat )
|
|
else
|
|
s_oGetListActive:SetFormat()
|
|
endif
|
|
endif
|
|
|
|
return
|
|
|
|
METHOD KillRead( lKill ) CLASS TGetList
|
|
|
|
local lSavKill := ::lKillRead
|
|
|
|
if PCount() > 0
|
|
::lKillRead = lKill
|
|
endif
|
|
|
|
return lSavKill
|
|
|
|
function ReadKill( lKill )
|
|
|
|
if PCount() > 0
|
|
return s_oGetListActive:KillRead( lKill )
|
|
endif
|
|
|
|
return s_oGetListActive:KillRead()
|
|
|
|
procedure __KillRead()
|
|
|
|
s_oGetListActive:KillRead( .T. )
|
|
|
|
return
|
|
|
|
METHOD GetActive( oGet ) CLASS TGetList
|
|
|
|
local oOldGet := ::oActiveGet
|
|
|
|
if PCount() > 0
|
|
::oActiveGet := oGet
|
|
endif
|
|
|
|
return oOldGet
|
|
|
|
function GetActive( oGet )
|
|
|
|
if s_oGetListActive != nil
|
|
if PCount() > 0
|
|
return s_oGetListActive:GetActive( oGet )
|
|
else
|
|
return s_oGetListActive:GetActive()
|
|
endif
|
|
endif
|
|
|
|
return nil
|
|
|
|
METHOD ShowScoreboard() CLASS TGetList
|
|
|
|
local nRow, nCol, nOldCursor
|
|
|
|
if Set( _SET_SCOREBOARD )
|
|
nRow = Row()
|
|
nCol = Col()
|
|
nOldCursor = SetCursor( SC_NONE )
|
|
DispOutAt( SCORE_ROW, SCORE_COL, If( Set( _SET_INSERT ), "Ins", " " ) )
|
|
SetPos( nRow, nCol )
|
|
SetCursor( nOldCursor )
|
|
endif
|
|
|
|
return nil
|
|
|
|
METHOD DateMsg() CLASS TGetList
|
|
|
|
local nRow
|
|
local nCol
|
|
|
|
if Set( _SET_SCOREBOARD )
|
|
|
|
nRow := Row()
|
|
nCol := Col()
|
|
|
|
DispOutAt( SCORE_ROW, SCORE_COL, "Invalid date" )
|
|
SetPos( nRow, nCol )
|
|
|
|
do while NextKey() == 0
|
|
enddo
|
|
|
|
DispOutAt( SCORE_ROW, SCORE_COL, Space( Len( "Invalid date" ) ) )
|
|
SetPos( nRow, nCol )
|
|
|
|
endif
|
|
|
|
return nil
|
|
|
|
METHOD ReadVar( cNewVarName ) CLASS TGetList
|
|
|
|
local cOldName := ::cVarName
|
|
|
|
if ISCHARACTER( cNewVarName )
|
|
::cVarName := cNewVarName
|
|
endif
|
|
|
|
return cOldName
|
|
|
|
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 )
|
|
|
|
METHOD ReadUpdated( lUpdated ) CLASS TGetList
|
|
|
|
local lSavUpdated := ::lUpdated
|
|
|
|
if PCount() > 0
|
|
::lUpdated = lUpdated
|
|
endif
|
|
|
|
return lSavUpdated
|
|
|
|
function ReadUpdated( lUpdated )
|
|
|
|
if PCount() > 0
|
|
return s_oGetListActive:ReadUpdated( lUpdated )
|
|
endif
|
|
|
|
return s_oGetListActive:ReadUpdated()
|
|
|
|
function Updated()
|
|
|
|
if s_oGetListActive != nil
|
|
return s_oGetListActive:lUpdated
|
|
endif
|
|
|
|
return .f.
|
|
|
|
procedure GetApplyKey( oGet, nKey )
|
|
|
|
if s_oGetListActive != nil
|
|
s_oGetListActive:oGet := oGet
|
|
s_oGetListActive:GetApplyKey( nKey )
|
|
endif
|
|
|
|
return
|