1290 lines
28 KiB
Plaintext
1290 lines
28 KiB
Plaintext
/*
|
|
* $Id$
|
|
*/
|
|
|
|
/*
|
|
* Harbour Project source code:
|
|
* Get Class
|
|
*
|
|
* Copyright 1999 Ignacio Ortiz de Z£niga <ignacio@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, 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 "hbsetup.ch"
|
|
|
|
#include "color.ch"
|
|
#include "common.ch"
|
|
#include "setcurs.ch"
|
|
#include "getexit.ch"
|
|
#include "inkey.ch"
|
|
#include "button.ch"
|
|
|
|
/* TODO: :posInBuffer( <nRow>, <nCol> ) --> nPos
|
|
Determines a position within the edit buffer based on screen
|
|
coordinates.
|
|
Xbase++ compatible method */
|
|
|
|
#define GET_CLR_UNSELECTED 0
|
|
#define GET_CLR_ENHANCED 1
|
|
|
|
//----------------------------------------------------------------------------//
|
|
|
|
|
|
CLASS Get
|
|
|
|
// Exported
|
|
|
|
DATA BadDate
|
|
DATA Buffer
|
|
DATA Cargo
|
|
DATA Changed
|
|
DATA Clear
|
|
DATA Col
|
|
DATA DecPos
|
|
DATA ExitState
|
|
DATA HasFocus
|
|
DATA Minus
|
|
DATA Name
|
|
DATA Original
|
|
DATA Pos
|
|
DATA PostBlock
|
|
DATA PreBlock
|
|
DATA Reader
|
|
DATA Rejected
|
|
DATA Row
|
|
DATA SubScript
|
|
DATA Type
|
|
DATA TypeOut
|
|
#ifdef HB_COMPAT_C53
|
|
DATA Control
|
|
DATA Message
|
|
#endif
|
|
|
|
DATA cColorSpec HIDDEN // Used only for METHOD ColorSpec
|
|
DATA cPicture HIDDEN // Used only for METHOD Picture
|
|
DATA bBlock HIDDEN // Used only for METHOD Block
|
|
|
|
METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec )
|
|
|
|
METHOD Assign()
|
|
#ifdef HB_COMPAT_XPP
|
|
MESSAGE _Assign METHOD Assign()
|
|
#endif
|
|
METHOD HitTest(mrow,mcol)
|
|
METHOD Block( bBlock ) SETGET // Replace to DATA Block
|
|
METHOD ColorSpec( cColorSpec ) SETGET // Replace to DATA ColorSpec
|
|
METHOD Picture( cPicture ) SETGET // Replace to DATA Picture
|
|
METHOD Display()
|
|
METHOD ColorDisp( cColorSpec ) INLINE ::ColorSpec := cColorSpec, ::Display(), Self
|
|
METHOD KillFocus()
|
|
METHOD ParsePict( cPicture )
|
|
METHOD Reset()
|
|
METHOD SetFocus()
|
|
METHOD Undo()
|
|
METHOD UnTransform()
|
|
METHOD UpdateBuffer() INLINE ::buffer := ::PutMask( ), ::Assign():Display(), Self
|
|
|
|
METHOD VarGet()
|
|
METHOD VarPut(xValue, lReFormat)
|
|
|
|
METHOD End()
|
|
#ifdef HB_COMPAT_XPP
|
|
MESSAGE _End METHOD End()
|
|
#endif
|
|
METHOD Home()
|
|
MESSAGE Left() METHOD _Left()
|
|
MESSAGE Right() METHOD _Right()
|
|
METHOD ToDecPos()
|
|
METHOD WordLeft()
|
|
METHOD WordRight()
|
|
|
|
METHOD BackSpace()
|
|
MESSAGE Delete() METHOD _Delete()
|
|
METHOD DelEnd()
|
|
METHOD DelLeft()
|
|
METHOD DelRight()
|
|
METHOD DelWordLeft()
|
|
METHOD DelWordRight()
|
|
|
|
METHOD Insert( cChar )
|
|
METHOD OverStrike( cChar )
|
|
|
|
// Protected
|
|
|
|
DATA cPicMask, cPicFunc, nMaxLen, lEdit, lDecRev, lPicComplex
|
|
DATA nDispLen, nDispPos, nOldPos
|
|
|
|
METHOD DeleteAll()
|
|
METHOD IsEditable( nPos )
|
|
METHOD Input( cChar )
|
|
METHOD PutMask( cBuffer, lEdit )
|
|
|
|
METHOD HasScroll() INLINE ::nDispLen != ::nMaxLen
|
|
|
|
ENDCLASS
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS Get
|
|
|
|
DEFAULT nRow TO Row()
|
|
DEFAULT nCol TO Col()
|
|
DEFAULT cVarName TO ""
|
|
DEFAULT bVarBlock TO IIF( ValType( cVarName ) == 'C', MemvarBlock( cVarName ), NIL )
|
|
DEFAULT cPicture TO ""
|
|
DEFAULT cColorSpec TO hb_ColorIndex( SetColor(), CLR_UNSELECTED ) + "," + hb_ColorIndex( SetColor(), CLR_ENHANCED )
|
|
|
|
::HasFocus := .f.
|
|
::BadDate := .f.
|
|
::Block := bVarBlock
|
|
::Changed := .f.
|
|
::Clear := .f.
|
|
::Col := nCol
|
|
::ColorSpec := cColorSpec
|
|
::DecPos := NIL
|
|
::ExitState := 0
|
|
::Minus := .f.
|
|
::Name := cVarName
|
|
::Original := ::VarGet()
|
|
::Pos := NIL
|
|
::PostBlock := NIL
|
|
::PreBlock := NIL
|
|
::Reader := NIL
|
|
::Rejected := .f.
|
|
::Row := nRow
|
|
::SubScript := NIL
|
|
::Type := ValType( ::Original )
|
|
::TypeOut := .f.
|
|
::nDispPos := 1
|
|
::nOldPos := 0
|
|
|
|
::Picture := cPicture
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD ParsePict( cPicture ) CLASS Get
|
|
|
|
local cChar
|
|
local nAt
|
|
local nFor
|
|
local cNum
|
|
|
|
cNum := ""
|
|
|
|
if Left( cPicture, 1 ) == "@"
|
|
|
|
nAt := At( " ", cPicture )
|
|
|
|
if nAt == 0
|
|
::cPicFunc := Upper( cPicture )
|
|
::cPicMask := ""
|
|
else
|
|
::cPicFunc := Upper( SubStr( cPicture, 1, nAt - 1 ) )
|
|
::cPicMask := SubStr( cPicture, nAt + 1 )
|
|
endif
|
|
|
|
if ( nAt := At( "S", ::cPicFunc ) ) > 0
|
|
for nFor := nAt + 1 to Len( ::cPicFunc )
|
|
if ! IsDigit( SubStr( ::cPicFunc, nFor, 1 ) )
|
|
exit
|
|
else
|
|
cNum += SubStr( ::cPicFunc, nFor, 1 )
|
|
endif
|
|
next
|
|
::nDispLen := Val(cNum)
|
|
::cPicFunc := SubStr( ::cPicFunc, 1, nAt - 1 ) + SubStr( ::cPicFunc, nFor )
|
|
endif
|
|
|
|
::cPicFunc := StrTran(::cPicFunc, "Z", "")
|
|
|
|
if ::cPicFunc == "@"
|
|
::cPicFunc := ""
|
|
endif
|
|
else
|
|
::cPicFunc := ""
|
|
::cPicMask := cPicture
|
|
endif
|
|
|
|
if ::type == "D"
|
|
::cPicMask := LTrim( ::cPicMask )
|
|
endif
|
|
|
|
// Comprobar si tiene la , y el . cambiado (Solo en Xbase++)
|
|
|
|
::lDecRev := "," $ Transform( 1.1, "9.9" )
|
|
|
|
// Generate default picture mask if not specified
|
|
|
|
if Empty( ::cPicMask )
|
|
|
|
do case
|
|
case ::type == "D"
|
|
|
|
::cPicMask := Set( _SET_DATEFORMAT )
|
|
::cPicMask := StrTran( ::cPicmask, "y", "9" )
|
|
::cPicMask := StrTran( ::cPicmask, "Y", "9" )
|
|
::cPicMask := StrTran( ::cPicmask, "m", "9" )
|
|
::cPicMask := StrTran( ::cPicmask, "M", "9" )
|
|
::cPicMask := StrTran( ::cPicmask, "d", "9" )
|
|
::cPicMask := StrTran( ::cPicmask, "D", "9" )
|
|
|
|
case ::type == "N"
|
|
|
|
cNum := Str( ::VarGet() )
|
|
if ( nAt := At( iif( ::lDecRev, ",", "." ), cNum ) ) > 0
|
|
::cPicMask := Replicate( '9', nAt - 1 ) + iif( ::lDecRev, ",", "." )
|
|
::cPicMask += Replicate( '9', Len( cNum ) - Len( ::cPicMask ) )
|
|
else
|
|
::cPicMask := Replicate( '9', Len( cNum ) )
|
|
endif
|
|
|
|
endcase
|
|
|
|
endif
|
|
|
|
// Comprobar si tiene caracteres embebidos no modificables en la plantilla
|
|
|
|
::lPicComplex := .f.
|
|
|
|
if ! Empty( ::cPicMask )
|
|
For nFor := 1 to Len( ::cPicMask )
|
|
cChar := SubStr( ::cPicMask, nFor, 1 )
|
|
if !cChar $ "!ANX9#"
|
|
::lPicComplex := .t.
|
|
exit
|
|
endif
|
|
Next
|
|
endif
|
|
|
|
return ::cPicFunc + ' ' + ::cPicMask
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD Assign() CLASS Get
|
|
|
|
::VarPut( ::unTransform(), .f. )
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD Display( lForced ) CLASS Get
|
|
|
|
local nOldCursor := SetCursor( SC_NONE )
|
|
|
|
DEFAULT lForced TO .t.
|
|
|
|
if ::HasScroll() .and. ::Pos != NIL
|
|
if ::nDispLen > 8
|
|
::nDispPos := Max( 1, Min( ::Pos - ::nDispLen + 4, ::nMaxLen - ::nDispLen + 1 ) )
|
|
else
|
|
::nDispPos := Max( 1, Min( ::Pos - int( ::nDispLen / 2 ), ::nMaxLen - ::nDispLen + 1 ) )
|
|
endif
|
|
endif
|
|
|
|
if ::buffer != NIL .and. ( lForced .or. ( ::nDispPos != ::nOldPos ) )
|
|
DispOutAt( ::Row, ::Col,;
|
|
Substr( ::buffer, ::nDispPos, ::nDispLen ), ;
|
|
hb_ColorIndex( ::ColorSpec, iif( ::HasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ) )
|
|
endif
|
|
|
|
::nOldPos := ::nDispPos
|
|
|
|
if ::Pos != NIL
|
|
SetPos( ::Row, ::Col + ::Pos - ::nDispPos )
|
|
endif
|
|
|
|
SetCursor( nOldCursor )
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD End() CLASS Get
|
|
|
|
local nLastCharPos
|
|
|
|
if ::HasFocus != nil .and. ::HasFocus
|
|
nLastCharPos := Min( Len( RTrim( ::buffer ) ) + 1, ::nMaxLen )
|
|
if ::Pos != nLastCharPos
|
|
::Pos := nLastCharPos
|
|
else
|
|
::Pos := ::nMaxLen
|
|
endif
|
|
::Clear := .f.
|
|
::Display( .f. )
|
|
endif
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD Home() CLASS Get
|
|
|
|
if ::HasFocus
|
|
::Pos := 1
|
|
::Clear := .f.
|
|
::Display( .f. )
|
|
endif
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD Reset() CLASS Get
|
|
|
|
if ::hasfocus
|
|
::buffer := ::PutMask( ::VarGet(), .f. )
|
|
::pos := 1
|
|
::TypeOut := .f.
|
|
endif
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD Undo() CLASS Get
|
|
|
|
if ::hasfocus
|
|
::VarPut( ::Original, .t. )
|
|
::pos := 1
|
|
endif
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD SetFocus() CLASS Get
|
|
|
|
local lWasNil := ::buffer == NIL
|
|
local nFor
|
|
|
|
::hasfocus := .t.
|
|
::rejected := .f.
|
|
::typeout := .f.
|
|
|
|
::Original := ::VarGet()
|
|
::type := ValType( ::Original )
|
|
::buffer := ::PutMask( ::VarGet(), .f. )
|
|
::changed := .f.
|
|
::clear := ( "K" $ ::cPicFunc .or. ::type == "N")
|
|
::nMaxLen := IIF( ::buffer == NIL, 0, Len( ::buffer ) )
|
|
::pos := 0
|
|
::lEdit := .f.
|
|
|
|
for nFor := 1 to ::nMaxLen
|
|
if ::IsEditable( nFor )
|
|
::pos := nFor
|
|
exit
|
|
endif
|
|
next
|
|
|
|
if ::pos = 0
|
|
::TypeOut = .t.
|
|
endif
|
|
|
|
if ::type == "N"
|
|
::decpos := At( iif( ::lDecRev .or. "E" $ ::cPicFunc, ",", "." ), ::buffer )
|
|
|
|
for nFor := 1 to ::nMaxLen
|
|
if ::IsEditable( nFor )
|
|
::minus := ( Substr( ::buffer, nFor, 1 ) $ "-(" )
|
|
endif
|
|
next
|
|
// ::minus := ( "-" $ ::buffer .or. "(" $ ::buffer )
|
|
else
|
|
::decpos := NIL
|
|
::minus := .f.
|
|
endif
|
|
|
|
if ::type == "D"
|
|
::BadDate := !( DToC( CToD( ::buffer ) ) == ::buffer )
|
|
else
|
|
::BadDate := .f.
|
|
endif
|
|
|
|
IF lWasNil .and. ::buffer != NIL
|
|
IF ::nDispLen == NIL
|
|
::nDispLen := ::nMaxLen
|
|
ENDIF
|
|
|
|
::Display( .T. )
|
|
ELSE
|
|
::Display()
|
|
ENDIF
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD KillFocus() CLASS Get
|
|
|
|
::Assign()
|
|
|
|
::hasfocus := .f.
|
|
::buffer := ::PutMask( )
|
|
::pos := NIL
|
|
|
|
::Display()
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD VarPut( xValue, lReFormat ) CLASS Get
|
|
|
|
DEFAULT lReFormat TO .t.
|
|
|
|
if ::block != nil
|
|
Eval( ::block, xValue )
|
|
if lReFormat
|
|
if !::hasfocus
|
|
::Original := xValue
|
|
endif
|
|
::Type := ValType( xValue )
|
|
::Picture( ::cPicture )
|
|
endif
|
|
endif
|
|
|
|
return xValue
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD VarGet() CLASS Get
|
|
|
|
return IIF( ValType( ::Block ) == 'B', Eval( ::Block ), NIL )
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD Untransform( cBuffer ) CLASS Get
|
|
|
|
local xValue
|
|
local cChar
|
|
local nFor
|
|
|
|
DEFAULT cBuffer TO ::buffer
|
|
|
|
do case
|
|
case ::type == "C"
|
|
|
|
if "R" $ ::cPicFunc
|
|
for nFor := 1 to Len( ::cPicMask )
|
|
cChar := SubStr( ::cPicMask, nFor, 1 )
|
|
if !cChar $ "ANX9#!"
|
|
cBuffer := SubStr( cBuffer, 1, nFor - 1 ) + Chr( 1 ) + SubStr( cBuffer, nFor + 1 )
|
|
endif
|
|
next
|
|
cBuffer := StrTran( cBuffer, Chr( 1 ), "" )
|
|
endif
|
|
|
|
xValue := cBuffer
|
|
|
|
case ::type == "N"
|
|
|
|
if "E" $ ::cPicFunc .or. ::lDecRev
|
|
cBuffer := StrTran( cBuffer, ".", " " )
|
|
cBuffer := StrTran( cBuffer, ",", "." )
|
|
else
|
|
cBuffer := StrTran( cBuffer, ",", " " )
|
|
endif
|
|
|
|
for nFor := 1 to ::nMaxLen
|
|
if !::IsEditable( nFor ) .and. SubStr( cBuffer, nFor, 1 ) != "."
|
|
cBuffer = Left( cBuffer, nFor-1 ) + " " + SubStr( cBuffer, nFor+1 )
|
|
endif
|
|
next
|
|
|
|
cBuffer := StrTran( cBuffer, "$", "" )
|
|
cBuffer := StrTran( cBuffer, "*", "" )
|
|
cBuffer := StrTran( cBuffer, "-", "" )
|
|
cBuffer := StrTran( cBuffer, "(", "" )
|
|
cBuffer := StrTran( cBuffer, ")", "" )
|
|
|
|
cBuffer := StrTran( cBuffer, " ", "" ) // It replace left, right
|
|
// and medium spaces.
|
|
// Don't replace for Alltrim()
|
|
|
|
xValue := 0 + Val( cBuffer ) // 0 + ... avoids setting the
|
|
if ::minus
|
|
xValue := -xValue
|
|
endif
|
|
|
|
case ::type == "L"
|
|
cBuffer := Upper( cBuffer )
|
|
xValue := "T" $ cBuffer .or. "Y" $ cBuffer
|
|
|
|
case ::type == "D"
|
|
if "E" $ ::cPicFunc
|
|
cBuffer := SubStr( cBuffer, 4, 3 ) + SubStr( cBuffer, 1, 3 ) + SubStr( cBuffer, 8 )
|
|
endif
|
|
xValue := CToD( cBuffer )
|
|
|
|
endcase
|
|
|
|
return xValue
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD overstrike( cChar ) CLASS Get
|
|
|
|
if ::type == "N" .and. ! ::lEdit .and. ::Clear
|
|
::pos := 1
|
|
endif
|
|
|
|
if ::Clear .and. ::pos == 1
|
|
::DeleteAll()
|
|
::Clear := .f.
|
|
::lEdit := .f.
|
|
endif
|
|
|
|
if ! ::lEdit
|
|
::lEdit := .t.
|
|
::buffer := ::PutMask( ::VarGet(), .t. )
|
|
endif
|
|
|
|
|
|
do while ! ::IsEditable( ::pos ) .and. ::pos <= ::nMaxLen
|
|
::pos++
|
|
enddo
|
|
|
|
if ::pos > ::nMaxLen
|
|
::pos := 1
|
|
endif
|
|
|
|
cChar := ::Input( cChar )
|
|
|
|
if cChar == ""
|
|
::Rejected := .t.
|
|
return Self
|
|
endif
|
|
|
|
::buffer := SubStr( ::buffer, 1, ::Pos - 1 ) + cChar + SubStr( ::buffer, ::Pos + 1 )
|
|
|
|
::Changed := !( ::unTransform() == ::Original )
|
|
::Assign()
|
|
::Right( .f. )
|
|
|
|
if ::type == "D"
|
|
::BadDate := !( DToC( CToD( ::buffer ) ) == ::buffer )
|
|
else
|
|
::BadDate := .f.
|
|
endif
|
|
|
|
::Display()
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD Insert( cChar ) CLASS Get
|
|
|
|
local n
|
|
local nMaxLen := ::nMaxLen
|
|
|
|
if ::type == "N" .and. ! ::lEdit .and. ::Clear
|
|
::pos := 1
|
|
endif
|
|
|
|
if ::Clear .and. ::pos == 1
|
|
::DeleteAll()
|
|
::Clear := .f.
|
|
::lEdit := .f.
|
|
endif
|
|
|
|
if ! ::lEdit
|
|
::lEdit := .t.
|
|
::buffer := ::PutMask( ::VarGet(), .t. )
|
|
endif
|
|
|
|
do while ! ::IsEditable( ::pos ) .and. ::pos <= ::nMaxLen
|
|
::pos++
|
|
enddo
|
|
|
|
if ::pos > ::nMaxLen
|
|
::pos := 1
|
|
endif
|
|
|
|
cChar := ::Input(cChar)
|
|
|
|
if cChar == ""
|
|
::Rejected := .t.
|
|
return Self
|
|
else
|
|
::Rejected := .f.
|
|
endif
|
|
|
|
if ::lPicComplex
|
|
// Calculating diferent nMaxLen for ::lPicComplex
|
|
|
|
for n := ::Pos to nMaxLen
|
|
if !::IsEditable( n )
|
|
exit
|
|
endif
|
|
next
|
|
nMaxLen := n
|
|
::buffer := Left( Substr( ::buffer, 1, ::Pos-1 ) + cChar +;
|
|
Substr( ::buffer, ::Pos, nMaxLen-1-::Pos ) +;
|
|
Substr( ::buffer, nMaxLen ), ::nMaxLen )
|
|
else
|
|
::buffer := Left( Substr( ::buffer, 1, ::Pos-1 ) + cChar + Substr( ::buffer, ::Pos ), ::nMaxLen )
|
|
endif
|
|
|
|
::Changed := !( ::unTransform() == ::Original )
|
|
::Assign()
|
|
::Right( .f. )
|
|
|
|
if ::type == "D"
|
|
::BadDate := !( DToC( CToD( ::buffer ) ) == ::buffer )
|
|
else
|
|
::BadDate := .f.
|
|
endif
|
|
|
|
::Display()
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD _Right( lDisplay ) CLASS Get
|
|
|
|
local nPos
|
|
|
|
DEFAULT lDisplay TO .t.
|
|
|
|
if ! ::hasfocus
|
|
return Self
|
|
endif
|
|
|
|
::TypeOut := .f.
|
|
::Clear := .f.
|
|
|
|
if ::pos == ::nMaxLen
|
|
::TypeOut := .t.
|
|
return Self
|
|
endif
|
|
|
|
nPos := ::Pos + 1
|
|
|
|
do while ! ::IsEditable( nPos ) .and. nPos <= ::nMaxLen
|
|
nPos++
|
|
Enddo
|
|
|
|
if nPos <= ::nMaxLen
|
|
::Pos := nPos
|
|
else
|
|
::TypeOut := .t.
|
|
endif
|
|
|
|
if lDisplay
|
|
::Display( .f. )
|
|
endif
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD _Left( lDisplay ) CLASS Get
|
|
|
|
local nPos
|
|
|
|
DEFAULT lDisplay TO .t.
|
|
|
|
if ! ::hasfocus
|
|
return Self
|
|
endif
|
|
|
|
::TypeOut := .f.
|
|
::Clear := .f.
|
|
|
|
if ::pos == 1
|
|
::TypeOut := .t.
|
|
return Self
|
|
endif
|
|
|
|
nPos := ::Pos - 1
|
|
|
|
do while ! ::IsEditable( nPos ) .and. nPos > 0
|
|
nPos--
|
|
Enddo
|
|
|
|
if nPos > 0
|
|
::Pos := nPos
|
|
else
|
|
::TypeOut := .t.
|
|
endif
|
|
|
|
if lDisplay
|
|
::Display( .f. )
|
|
endif
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD WordLeft() CLASS Get
|
|
|
|
local nPos
|
|
|
|
if ! ::hasfocus
|
|
return Self
|
|
endif
|
|
|
|
::TypeOut := .f.
|
|
::Clear := .f.
|
|
|
|
if ::pos == 1
|
|
::TypeOut := .t.
|
|
return Self
|
|
endif
|
|
|
|
nPos := ::Pos - 1
|
|
|
|
do while nPos > 0
|
|
if SubStr( ::buffer, nPos, 1 ) == " "
|
|
do while nPos > 0 .and. SubStr( ::buffer, nPos, 1 ) == " "
|
|
nPos--
|
|
Enddo
|
|
do while nPos > 0 .and. !( SubStr( ::buffer, nPos, 1 ) == " " )
|
|
nPos--
|
|
Enddo
|
|
if nPos > 0
|
|
nPos++
|
|
endif
|
|
Exit
|
|
endif
|
|
nPos--
|
|
Enddo
|
|
|
|
if nPos < 1
|
|
nPos := 1
|
|
endif
|
|
|
|
if nPos > 0
|
|
::Pos := nPos
|
|
endif
|
|
|
|
::Display( .f. )
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD WordRight() CLASS Get
|
|
|
|
local nPos
|
|
|
|
if ! ::hasfocus
|
|
return Self
|
|
endif
|
|
|
|
::TypeOut := .f.
|
|
::Clear := .f.
|
|
|
|
if ::pos == ::nMaxLen
|
|
::TypeOut := .t.
|
|
return Self
|
|
endif
|
|
|
|
nPos := ::Pos + 1
|
|
|
|
do while nPos <= ::nMaxLen
|
|
if SubStr( ::buffer, nPos, 1 ) == " "
|
|
do while nPos <= ::nMaxLen .and. SubStr( ::buffer, nPos, 1 ) == " "
|
|
nPos++
|
|
Enddo
|
|
Exit
|
|
endif
|
|
nPos++
|
|
Enddo
|
|
|
|
if nPos > ::nMaxLen
|
|
nPos := ::nMaxLen
|
|
endif
|
|
|
|
if nPos <= ::nMaxLen
|
|
::Pos := nPos
|
|
endif
|
|
|
|
::Display( .f. )
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD ToDecPos() CLASS Get
|
|
|
|
if ! ::HasFocus .or. ::DecPos == NIL
|
|
return Self
|
|
endif
|
|
|
|
if ::pos == 1
|
|
::DeleteAll()
|
|
endif
|
|
|
|
::Clear := .f.
|
|
::lEdit := .t.
|
|
::buffer := ::PutMask( ::UnTransform(), .f. )
|
|
::pos := ::DecPos + 1
|
|
|
|
::Display( .t. )
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD IsEditable( nPos ) CLASS Get
|
|
|
|
local cChar
|
|
|
|
if Empty( ::cPicMask )
|
|
return .t.
|
|
endif
|
|
|
|
if nPos > ::nMaxLen
|
|
return .f.
|
|
endif
|
|
|
|
cChar := SubStr( ::cPicMask, nPos, 1 )
|
|
|
|
do case
|
|
case ::type == "C"
|
|
return cChar $ "!ANX9#"
|
|
case ::type == "N"
|
|
return cChar $ "9#$*"
|
|
case ::type == "D"
|
|
return cChar == "9"
|
|
case ::type == "L"
|
|
return cChar $ "TFYN"
|
|
endcase
|
|
|
|
return .f.
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD Input( cChar ) CLASS Get
|
|
|
|
local cPic
|
|
|
|
do case
|
|
case ::type == "N"
|
|
|
|
do case
|
|
case cChar == "-"
|
|
if ::pos != 1
|
|
return ""
|
|
endif
|
|
::minus := .t.
|
|
|
|
case cChar $ ".,"
|
|
::toDecPos()
|
|
return ""
|
|
|
|
case !( cChar $ "0123456789" )
|
|
return ""
|
|
|
|
endcase
|
|
|
|
case ::type == "D"
|
|
|
|
if !( cChar $ "0123456789" )
|
|
return ""
|
|
endif
|
|
|
|
case ::type == "L"
|
|
|
|
if !( Upper( cChar ) $ "YNTF" )
|
|
return ""
|
|
endif
|
|
|
|
endcase
|
|
|
|
if ! Empty( ::cPicFunc )
|
|
cChar := Transform( cChar, ::cPicFunc )
|
|
endif
|
|
|
|
if ! Empty( ::cPicMask )
|
|
cPic := Substr( ::cPicMask, ::pos, 1 )
|
|
|
|
cChar := Transform( cChar, cPic )
|
|
do case
|
|
case cPic == "A"
|
|
if ! IsAlpha( cChar )
|
|
cChar := ""
|
|
endif
|
|
case cPic == "N"
|
|
if ! IsAlpha( cChar ) .and. ! IsDigit( cChar )
|
|
cChar := ""
|
|
endif
|
|
case cPic == "9"
|
|
if ! IsDigit( cChar ) .and. cChar != "-"
|
|
cChar := ""
|
|
endif
|
|
case cPic == "#"
|
|
if ! IsDigit( cChar ) .and. !( cChar == " " ) .and. !( cChar $ "+-" )
|
|
cChar := ""
|
|
endif
|
|
end case
|
|
endif
|
|
|
|
return cChar
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD PutMask( xValue, lEdit ) CLASS Get
|
|
|
|
local cChar, cMask
|
|
local cBuffer
|
|
|
|
local nFor
|
|
local nLen
|
|
local nAt
|
|
|
|
DEFAULT xValue TO ::VarGet()
|
|
DEFAULT lEdit TO ::HasFocus
|
|
|
|
if xValue == NIL .OR. ValType( xValue ) $ "AB"
|
|
return NIL
|
|
endif
|
|
|
|
cBuffer := Transform( xValue, if( Empty( ::cPicFunc ), "", ::cPicFunc + " " ) + ::cPicMask )
|
|
|
|
if lEdit .and. ::type == "N" .and. ! Empty( ::cPicMask )
|
|
nLen := Len( cBuffer )
|
|
cMask := ::cPicMask
|
|
if "E" $ ::cPicFunc
|
|
cMask := StrTran(cMask, ",", Chr(1))
|
|
cMask := StrTran(cMask, ".", ",")
|
|
cMask := StrTran(cMask, Chr(1), ".")
|
|
endif
|
|
for nFor := 1 to nLen
|
|
cChar := SubStr( cMask, nFor, 1 )
|
|
if cChar $ ",." .and. SubStr( cBuffer, nFor, 1 ) != cChar
|
|
cBuffer := SubStr( cBuffer, 1, nFor - 1 ) + cChar + SubStr( cBuffer, nFor + 1 )
|
|
endif
|
|
next
|
|
if ::lEdit .and. Empty(xValue)
|
|
cBuffer := StrTran(cBuffer, "0", " ")
|
|
endif
|
|
if ::lDecRev
|
|
cBuffer := StrTran( cBuffer, ",", Chr( 1 ) )
|
|
cBuffer := StrTran( cBuffer, ".", "," )
|
|
cBuffer := StrTran( cBuffer, Chr( 1 ), "." )
|
|
endif
|
|
endif
|
|
|
|
return cBuffer
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD BackSpace( lDisplay ) CLASS Get
|
|
|
|
local nPos := ::Pos
|
|
|
|
DEFAULT lDisplay TO .t.
|
|
|
|
::Left()
|
|
|
|
if ::Pos < nPos
|
|
::Delete( lDisplay )
|
|
endif
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD _Delete( lDisplay ) CLASS Get
|
|
|
|
LOCAL nMaxLen := ::nMaxLen, n
|
|
|
|
DEFAULT lDisplay TO .t.
|
|
|
|
::Clear := .f.
|
|
::lEdit := .t.
|
|
|
|
if ::lPicComplex
|
|
// Calculating diferent nMaxLen for ::lPicComplex
|
|
for n := ::Pos to nMaxLen
|
|
if !::IsEditable( n )
|
|
exit
|
|
endif
|
|
next
|
|
nMaxLen := n - 1
|
|
endif
|
|
|
|
::buffer := PadR( SubStr( ::buffer, 1, ::Pos - 1 ) + ;
|
|
SubStr( ::buffer, ::Pos + 1, nMaxLen - ::Pos ) + " " +;
|
|
SubStr( ::buffer, nMaxLen + 1 ), ::nMaxLen )
|
|
|
|
if ::type == "D"
|
|
::BadDate := !( DToC( CToD( ::buffer ) ) == ::buffer )
|
|
else
|
|
::BadDate := .f.
|
|
endif
|
|
|
|
::Assign()
|
|
|
|
if lDisplay
|
|
::Display()
|
|
endif
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD DeleteAll() CLASS Get
|
|
|
|
local xValue
|
|
|
|
::lEdit := .t.
|
|
|
|
do case
|
|
case ::type == "C"
|
|
xValue := Space( ::nMaxlen )
|
|
case ::type == "N"
|
|
xValue := 0
|
|
case ::type == "D"
|
|
xValue := CToD( "" )
|
|
case ::type == "L"
|
|
xValue := .f.
|
|
endcase
|
|
|
|
::buffer := ::PutMask( xValue, .t. )
|
|
::Pos := 1
|
|
::Assign()
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD DelEnd() CLASS Get
|
|
|
|
local nPos := ::Pos
|
|
|
|
if ! ::hasfocus
|
|
return Self
|
|
endif
|
|
|
|
::Pos := ::nMaxLen
|
|
|
|
do while ::Pos > nPos
|
|
::BackSpace( .f. )
|
|
enddo
|
|
|
|
::Display()
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD DelLeft() CLASS Get
|
|
|
|
::Left( .f. )
|
|
::Delete( .f. )
|
|
::Right()
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD DelRight() CLASS Get
|
|
|
|
::Right( .f. )
|
|
::Delete( .f. )
|
|
::Left()
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD DelWordLeft() CLASS Get
|
|
|
|
if ! ::hasfocus
|
|
return Self
|
|
endif
|
|
|
|
if !( SubStr( ::buffer, ::Pos, 1 ) == " " )
|
|
if SubStr( ::buffer, ::Pos - 1 , 1 ) == " "
|
|
::BackSpace( .f. )
|
|
else
|
|
::WordRight()
|
|
::Left()
|
|
endif
|
|
endif
|
|
|
|
if SubStr( ::buffer, ::Pos, 1 ) == " "
|
|
::Delete( .f. )
|
|
endif
|
|
|
|
do while ::Pos > 1 .and. !( SubStr( ::buffer, ::Pos - 1, 1 ) == " " )
|
|
::BackSpace( .f. )
|
|
Enddo
|
|
|
|
::Display()
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
METHOD DelWordRight() CLASS Get
|
|
|
|
if ! ::hasfocus
|
|
return Self
|
|
endif
|
|
|
|
::TypeOut := .f.
|
|
::Clear := .f.
|
|
|
|
if ::pos == ::nMaxLen
|
|
::TypeOut := .t.
|
|
return Self
|
|
endif
|
|
|
|
do while ::Pos <= ::nMaxLen .and. !( SubStr( ::buffer, ::Pos, 1 ) == " " )
|
|
::Delete( .f. )
|
|
Enddo
|
|
|
|
if ::Pos <= ::nMaxLen
|
|
::Delete( .f. )
|
|
endif
|
|
|
|
::Display()
|
|
|
|
return Self
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
/* The METHOD ColorSpec and DATA cColorSpec allow to replace the
|
|
* property ColorSpec for a function to control the content and
|
|
* to carry out certain actions to normalize the data.
|
|
* The particular case is that the function receives a single color and
|
|
* be used for GET_CLR_UNSELECTED and GET_CLR_ENHANCED.
|
|
*/
|
|
|
|
METHOD ColorSpec( cColorSpec ) CLASS Get
|
|
|
|
local cClrUnSel, cClrEnh
|
|
|
|
if cColorSpec != NIL
|
|
|
|
cClrUnSel := iif( !Empty( hb_ColorIndex( cColorSpec, GET_CLR_UNSELECTED ) ),;
|
|
hb_ColorIndex( cColorSpec, GET_CLR_UNSELECTED ),;
|
|
hb_ColorIndex( SetColor(), GET_CLR_UNSELECTED ) )
|
|
|
|
cClrEnh := iif( !Empty( hb_ColorIndex( cColorSpec, GET_CLR_ENHANCED ) ),;
|
|
hb_ColorIndex( cColorSpec, GET_CLR_ENHANCED ),;
|
|
cClrUnSel )
|
|
|
|
::cColorSpec := cClrUnSel + " , " + cClrEnh
|
|
|
|
endif
|
|
|
|
return ::cColorSpec
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
/* The METHOD Picture and DATA cPicture allow to replace the
|
|
* property Picture for a function to control the content and
|
|
* to carry out certain actions to normalize the data.
|
|
* The particular case is that the Picture is loaded later on
|
|
* to the creation of the object, being necessary to carry out
|
|
* several tasks to adjust the internal data of the object.
|
|
*/
|
|
|
|
METHOD Picture( cPicture ) CLASS Get
|
|
|
|
if cPicture != NIL
|
|
|
|
::nDispLen := NIL
|
|
|
|
::cPicture := cPicture
|
|
::ParsePict( cPicture )
|
|
|
|
::buffer := ::PutMask( )
|
|
::nMaxLen := IIF( ::buffer == NIL, 0, Len( ::buffer ) )
|
|
|
|
if ::nDispLen == NIL
|
|
::nDispLen := ::nMaxLen
|
|
endif
|
|
|
|
endif
|
|
|
|
return ::cPicture
|
|
|
|
//---------------------------------------------------------------------------//
|
|
|
|
/* The METHOD Block and DATA bBlock allow to replace the
|
|
* property Block for a function to control the content and
|
|
* to carry out certain actions to normalize the data.
|
|
* The particular case is that the Block is loaded later on
|
|
* to the creation of the object, being necessary to carry out
|
|
* several tasks to adjust the internal data of the object
|
|
* to display correctly.
|
|
*/
|
|
|
|
METHOD Block( bBlock ) CLASS Get
|
|
|
|
if bBlock != NIL .AND. !::HasFocus
|
|
|
|
::bBlock := bBlock
|
|
::Original := ::VarGet()
|
|
::Type := ValType( ::Original )
|
|
|
|
::Picture( ::Picture )
|
|
|
|
endif
|
|
|
|
return ::bBlock
|
|
|
|
METHOD HitTest(mrow,mcol) CLASS GET
|
|
if ::row != mrow
|
|
return HTNOWHERE
|
|
endif
|
|
if mcol >= ::col .and. mrow <= ::col+::ndispLen
|
|
return HTCLIENT
|
|
endif
|
|
return HTNOWHERE
|
|
|