fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
22835dc3a69ac9b14ebb1ae142c00aebbd3d9df1
harbour-core/harbour/source/rtl/tget.prg
Przemyslaw Czerpak 666d3381b7 2008-07-28 18:20 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) 
* harbour/source/rtl/tget.prg
    ! fixed translation comma/dot translation for pictures with "@E"
      Viktor, please test it - I'm not very familiar with GET code
      and it's possible that I made sth wrong
2008-07-28 16:20:27 +00:00

1916 lines
48 KiB
Plaintext
Raw Blame History

/*
* $Id$
*/
/*
* Harbour Project source code:
* Get Class
*
* Copyright 2007-2008 Viktor Szakats <viktor.szakats@syenar.hu>
* 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 "hblang.ch"
#include "color.ch"
#include "common.ch"
#include "setcurs.ch"
#include "getexit.ch"
#include "inkey.ch"
#include "button.ch"
/* TOFIX: ::Minus [vszakats] */
#define GET_CLR_UNSELECTED 0
#define GET_CLR_ENHANCED 1
#define GET_CLR_CAPTION 2
#define GET_CLR_ACCEL 3
/* NOTE: In CA-Cl*pper TGET class does not inherit from any other classes
and there is no public class function like Get(). There is
in XPP though. */
#if defined(HB_C52_STRICT) && !defined(HB_COMPAT_XPP)
CREATE CLASS Get STATIC
#else
CREATE CLASS Get
#endif
EXPORTED:
/* === Start of CA-Cl*pper compatible TGet instance area === */
VAR bBlock PROTECTED /* 01. */
VAR subScript /* 02. */
VAR cPicture PROTECTED /* 03. */
VAR postBlock /* 04. */
VAR preBlock /* 05. */
VAR cargo /* 06. */
VAR cName PROTECTED /* 07. */
VAR cInternal1 HIDDEN /* 08. U2Bin( ::nRow ) + U2Bin( ::nCol ) + trash. Not implemented in Harbour. */
VAR exitState /* 09. */
VAR reader /* 10. */
#ifdef HB_COMPAT_C53
VAR oControl PROTECTED /* 11. CA-Cl*pper 5.3 only. */
VAR cCaption PROTECTED INIT "" /* 12. CA-Cl*pper 5.3 only. */
VAR nCapCol PROTECTED INIT 0 /* 13. CA-Cl*pper 5.3 only. */
VAR nCapRow PROTECTED INIT 0 /* 14. CA-Cl*pper 5.3 only. */
VAR cMessage PROTECTED INIT "" /* 15. CA-Cl*pper 5.3 only. */
VAR nDispLen PROTECTED /* 16. CA-Cl*pper 5.3 places it here. */
#endif
VAR cType PROTECTED /* +1. Only accessible in CA-Cl*pper when ::hasFocus == .T. In CA-Cl*pper the field may contain random chars after the first one, which is the type. */
VAR cBuffer PROTECTED /* +2. Only accessible in CA-Cl*pper when ::hasFocus == .T. */
VAR xVarGet PROTECTED /* +3. Only accessible in CA-Cl*pper when ::hasFocus == .T. */
/* === End of CA-Cl*pper compatible TGet instance area === */
VAR decPos INIT 0 READONLY /* ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. [vszakats] */
VAR hasFocus INIT .F. READONLY
VAR original READONLY
VAR rejected INIT .F. READONLY
VAR typeOut INIT .F. READONLY
METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) /* NOTE: This method is a Harbour extension [vszakats] */
METHOD assign()
METHOD badDate()
METHOD block( bBlock ) SETGET
METHOD buffer( cBuffer ) SETGET
METHOD changed( lChanged ) SETGET
METHOD clear( lClear ) SETGET
METHOD col( nCol ) SETGET
METHOD colorDisp( cColorSpec )
METHOD colorSpec( cColorSpec ) SETGET
METHOD display()
#ifdef HB_COMPAT_C53
METHOD hitTest( nMRow, nMCol )
METHOD control( oControl ) SETGET /* NOTE: Undocumented CA-Cl*pper 5.3 method. */
METHOD message( cMessage ) SETGET /* NOTE: Undocumented CA-Cl*pper 5.3 method. */
METHOD caption( cCaption ) SETGET /* NOTE: Undocumented CA-Cl*pper 5.3 method. */
METHOD capRow( nCapRow ) SETGET /* NOTE: Undocumented CA-Cl*pper 5.3 method. */
METHOD capCol( nCapCol ) SETGET /* NOTE: Undocumented CA-Cl*pper 5.3 method. */
#endif
METHOD killFocus()
METHOD minus( lMinus ) SETGET
METHOD name( cName ) SETGET
METHOD picture( cPicture ) SETGET
METHOD pos( nPos ) SETGET
#ifdef HB_COMPAT_XPP
METHOD posInBuffer( nRow, nCol )
#endif
#ifdef HB_C52_UNDOC
METHOD reform()
#endif
METHOD reset()
METHOD row( nRow ) SETGET
METHOD setFocus()
METHOD type()
METHOD undo()
METHOD unTransform()
METHOD updateBuffer()
METHOD varGet()
METHOD varPut( xValue )
METHOD end()
METHOD home()
METHOD left()
METHOD right()
METHOD toDecPos()
METHOD wordLeft()
METHOD wordRight()
METHOD backSpace()
METHOD delete()
METHOD delEnd()
METHOD delLeft()
METHOD delRight()
METHOD delWordLeft()
METHOD delWordRight()
METHOD insert( cChar )
METHOD overStrike( cChar )
#ifdef HB_EXTENSION
METHOD hideInput( lHideInput ) SETGET
METHOD style( cStyle ) SETGET
#endif
#ifdef HB_COMPAT_XPP
MESSAGE _end() METHOD end()
MESSAGE _assign() METHOD assign()
MESSAGE _delete() METHOD delete()
#endif
PROTECTED:
#ifndef HB_COMPAT_C53
VAR nDispLen /* NOTE: This one is placed inside the instance area for CA-Cl*pper 5.3 [vszakats] */
#endif
VAR cColorSpec
VAR nPos INIT 0
VAR lChanged INIT .F.
VAR lClear INIT .F.
VAR nRow
VAR nCol
VAR lRejected INIT .F.
VAR lHideInput INIT .F.
VAR cStyle INIT "*" /* NOTE: First char is to be used as mask character when :hideInput is .T. [vszakats] */
VAR nMaxLen
VAR lEdit INIT .F.
VAR nDispPos INIT 1
VAR nOldPos INIT 0
VAR nMaxEdit
VAR lMinus INIT .F.
VAR lMinus2 INIT .F.
VAR lMinusPrinted INIT .F.
VAR lSuppDisplay INIT .F.
VAR nPicLen
VAR cPicMask INIT ""
VAR cPicFunc INIT ""
VAR lPicComplex INIT .F.
VAR lPicBlankZero INIT .F.
METHOD leftLow()
METHOD rightLow()
METHOD backSpaceLow()
METHOD deleteLow()
METHOD DeleteAll()
METHOD IsEditable( nPos )
METHOD Input( cChar )
METHOD PutMask( xValue, lEdit )
METHOD FirstEditable()
METHOD LastEditable()
ENDCLASS
METHOD assign() CLASS Get
LOCAL xValue
IF ::hasFocus
xValue := ::unTransform()
IF ::cType == "C"
xValue += SubStr( ::original, Len( xValue ) + 1 )
ENDIF
::varPut( xValue )
ENDIF
RETURN Self
METHOD updateBuffer() CLASS Get
IF ::hasFocus
::cBuffer := ::PutMask( ::varGet() )
::xVarGet := ::original
::display()
ELSE
::varGet()
ENDIF
RETURN Self
METHOD display() CLASS Get
LOCAL nOldCursor := SetCursor( SC_NONE )
LOCAL cBuffer
LOCAL nDispPos
#ifdef HB_COMPAT_C53
LOCAL nPos
LOCAL cCaption
#endif
IF ::hasFocus
cBuffer := ::cBuffer
ELSE
::cType := ValType( ::xVarGet := ::varGet() )
::picture := ::cPicture
cBuffer := ::PutMask( ::xVarGet )
ENDIF
::nMaxLen := Len( cBuffer )
::nDispLen := iif( ::nPicLen == NIL, ::nMaxLen, ::nPicLen )
IF ::cType == "N" .AND. ::hasFocus .AND. ! ::lMinusPrinted .AND. ;
::decPos != 0 .AND. ::lMinus2 .AND. ;
::nPos > ::decPos .AND. Val( Left( cBuffer, ::decPos - 1 ) ) == 0
/* Display "-." only in case when value on the left side of
the decimal point is equal 0 */
cBuffer := SubStr( cBuffer, 1, ::decPos - 2 ) + "-." + SubStr( cBuffer, ::decPos + 1 )
ENDIF
IF ::nDispLen != ::nMaxLen .AND. ::nPos != 0 /* ; has scroll? */
IF ::nDispLen > 8
nDispPos := Max( 1, Min( ::nPos - ::nDispLen + 4 , ::nMaxLen - ::nDispLen + 1 ) )
ELSE
nDispPos := Max( 1, Min( ::nPos - Int( ::nDispLen / 2 ), ::nMaxLen - ::nDispLen + 1 ) )
ENDIF
ELSE
nDispPos := 1
ENDIF
#ifdef HB_COMPAT_C53
/* Handle C5.3 caption. */
IF !Empty( ::cCaption )
cCaption := ::cCaption
IF ( nPos := At( "&", cCaption ) ) > 0
IF nPos == Len( cCaption )
nPos := 0
ELSE
cCaption := Stuff( cCaption, nPos, 1, "" )
ENDIF
ENDIF
DispOutAt( ::nCapRow, ::nCapCol, cCaption, hb_ColorIndex( ::cColorSpec, GET_CLR_CAPTION ) )
IF nPos > 0
DispOutAt( ::nCapRow, ::nCapCol + nPos - 1, SubStr( cCaption, nPos, 1 ), hb_ColorIndex( ::cColorSpec, GET_CLR_ACCEL ) )
ENDIF
ENDIF
#endif
/* Display the GET */
IF !::lSuppDisplay .OR. nDispPos != ::nOldPos
DispOutAt( ::nRow, ::nCol,;
iif( ::lHideInput, PadR( Replicate( SubStr( ::cStyle, 1, 1 ), Len( RTrim( cBuffer ) ) ), ::nDispLen ), SubStr( cBuffer, nDispPos, ::nDispLen ) ),;
hb_ColorIndex( ::cColorSpec, iif( ::hasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ) )
IF Set( _SET_DELIMITERS ) .AND. !::hasFocus
#ifdef HB_COMPAT_C53
DispOutAt( ::nRow, ::nCol - 1, SubStr( Set( _SET_DELIMCHARS ), 1, 1 ), hb_ColorIndex( ::cColorSpec, GET_CLR_UNSELECTED ) )
DispOutAt( ::nRow, ::nCol + ::nDispLen, SubStr( Set( _SET_DELIMCHARS ), 2, 1 ), hb_ColorIndex( ::cColorSpec, GET_CLR_UNSELECTED ) )
#else
/* NOTE: C5.2 will use the default color. We're replicating this here. [vszakats] */
DispOutAt( ::nRow, ::nCol - 1, SubStr( Set( _SET_DELIMCHARS ), 1, 1 ) )
DispOutAt( ::nRow, ::nCol + ::nDispLen, SubStr( Set( _SET_DELIMCHARS ), 2, 1 ) )
#endif
ENDIF
ENDIF
IF ::nPos != 0
SetPos( ::nRow, ::nCol + ::nPos - nDispPos )
ENDIF
::nOldPos := nDispPos
::lSuppDisplay := .F.
SetCursor( nOldCursor )
RETURN Self
/* ------------------------------------------------------------------------- */
METHOD colorDisp( cColorSpec ) CLASS Get
::colorSpec( cColorSpec )
::display()
RETURN Self
METHOD end() CLASS Get
LOCAL nLastCharPos
LOCAL nPos
LOCAL nFor
IF ::hasFocus
nLastCharPos := Min( Len( RTrim( ::cBuffer ) ) + 1, ::nMaxEdit )
IF ::nPos != nLastCharPos
nPos := nLastCharPos
ELSE
nPos := ::nMaxEdit
ENDIF
FOR nFor := nPos TO ::FirstEditable() STEP -1
IF ::IsEditable( nFor )
::pos := nFor
EXIT
ENDIF
NEXT
::lClear := .F.
::typeOut := ( ::nPos == 0 )
::lSuppDisplay := .T.
::display()
ENDIF
RETURN Self
METHOD home() CLASS Get
IF ::hasFocus
::pos := ::FirstEditable()
::lClear := .F.
::typeOut := ( ::nPos == 0 )
::lSuppDisplay := .T.
::display()
ENDIF
RETURN Self
METHOD reset() CLASS Get
IF ::hasFocus
::cBuffer := ::PutMask( ::varGet(), .F. )
::xVarGet := ::original
::cType := ValType( ::xVarGet )
::pos := ::FirstEditable() /* ; Simple 0 in CA-Cl*pper [vszakats] */
::lClear := ( "K" $ ::cPicFunc .OR. ::cType == "N" )
::lEdit := .F.
::lMinus := .F.
::rejected := .F.
::typeOut := !( ::type $ "CNDL" ) .OR. ( ::nPos == 0 ) /* ; Simple .F. in CA-Cl*pper [vszakats] */
::display()
ENDIF
RETURN Self
METHOD undo() CLASS Get
IF ::hasFocus
IF ::original != NIL
::varPut( ::original )
ENDIF
::reset()
::lChanged := .F.
ENDIF
RETURN Self
METHOD setFocus() CLASS Get
LOCAL xVarGet
IF !::hasFocus
xVarGet := ::xVarGet := ::varGet()
::hasFocus := .T.
::rejected := .F.
::original := xVarGet
::cType := ValType( xVarGet )
::picture := ::cPicture
::cBuffer := ::PutMask( xVarGet, .F. )
::lChanged := .F.
::lClear := ( "K" $ ::cPicFunc .OR. ::cType == "N" )
::lEdit := .F.
::pos := 1
::lMinusPrinted := .F.
::lMinus := .F.
IF ::cType == "N"
::decPos := At( iif( "E" $ ::cPicFunc, ",", "." ), ::cBuffer )
IF ::decPos == 0
::decPos := Len( ::cBuffer ) + 1
ENDIF
::lMinus2 := ( ::xVarGet < 0 )
ELSE
::decPos := 0 /* ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. [vszakats] */
ENDIF
::display()
ENDIF
RETURN Self
METHOD killFocus() CLASS Get
LOCAL lHadFocus := ::hasFocus
::hasFocus := .F.
::nPos := 0
::lClear := .F.
::lMinus := .F.
::lChanged := .F.
::decPos := 0 /* ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. [vszakats] */
::typeOut := .F.
IF lHadFocus
::display()
ENDIF
::xVarGet := NIL
::original := NIL
::cBuffer := NIL
RETURN Self
METHOD varPut( xValue ) CLASS Get
LOCAL aSubs
LOCAL nLen
LOCAL i
LOCAL aValue
IF ISBLOCK( ::bBlock ) .AND. ValType( xValue ) $ "CNDLU"
aSubs := ::subScript
IF ISARRAY( aSubs ) .AND. ! Empty( aSubs )
nLen := Len( aSubs )
aValue := Eval( ::bBlock )
FOR i := 1 TO nLen - 1
IF ISNUMBER( aSubs[ i ] )
aValue := aValue[ aSubs[ i ] ]
ELSE
EXIT
ENDIF
NEXT
IF ISNUMBER( aSubs[ i ] )
aValue[ aSubs[ i ] ] := xValue
ENDIF
ELSE
Eval( ::bBlock, xValue )
ENDIF
ELSE
xValue := NIL
ENDIF
RETURN xValue
METHOD varGet() CLASS Get
LOCAL aSubs
LOCAL nLen
LOCAL i
LOCAL xValue
IF ISBLOCK( ::bBlock )
aSubs := ::subScript
IF ISARRAY( aSubs ) .AND. ! Empty( aSubs )
nLen := Len( aSubs )
xValue := Eval( ::bBlock )
FOR i := 1 TO nLen
IF ISNUMBER( aSubs[ i ] )
xValue := xValue[ aSubs[ i ] ]
ELSE
EXIT
ENDIF
NEXT
ELSE
xValue := Eval( ::bBlock )
ENDIF
ELSE
xValue := ::xVarGet
ENDIF
RETURN xValue
/* NOTE: CA-Cl*pper will corrupt memory if cChar contains
multiple chars. [vszakats] */
METHOD overStrike( cChar ) CLASS Get
IF ::hasFocus
IF ::cType == "N" .AND. ! ::lEdit .AND. ::lClear
::pos := ::FirstEditable()
ENDIF
IF ::pos <= ::nMaxEdit
cChar := ::Input( cChar )
IF cChar == ""
::rejected := .T.
ELSE
::rejected := .F.
IF ::lClear .AND. ::nPos == ::FirstEditable()
::DeleteAll()
::lClear := .F.
ENDIF
::lEdit := .T.
IF ::nPos == 0
::pos := 1
ENDIF
DO WHILE ! ::IsEditable( ::nPos ) .AND. ::nPos <= ::nMaxEdit
::pos++
ENDDO
IF ::nPos > ::nMaxEdit
::pos := ::FirstEditable()
ENDIF
::cBuffer := SubStr( ::cBuffer, 1, ::nPos - 1 ) + cChar + SubStr( ::cBuffer, ::nPos + 1 )
::lChanged := .T.
::rightLow()
ENDIF
ENDIF
::display()
ENDIF
RETURN Self
/* NOTE: CA-Cl*pper will corrupt memory if cChar contains
multiple chars. [vszakats] */
METHOD insert( cChar ) CLASS Get
LOCAL nFor
LOCAL nMaxEdit
IF ::hasFocus
nMaxEdit := ::nMaxEdit
IF ::cType == "N" .AND. ! ::lEdit .AND. ::lClear
::pos := ::FirstEditable()
ENDIF
IF ::nPos <= ::nMaxEdit
cChar := ::Input( cChar )
IF cChar == ""
::rejected := .T.
ELSE
::rejected := .F.
IF ::lClear .AND. ::nPos == ::FirstEditable()
::DeleteAll()
::lClear := .F.
ENDIF
::lEdit := .T.
IF ::nPos == 0
::pos := 1
ENDIF
DO WHILE ! ::IsEditable( ::nPos ) .AND. ::nPos <= ::nMaxEdit
::pos++
ENDDO
IF ::nPos > ::nMaxEdit
::pos := ::FirstEditable()
ENDIF
IF ::lPicComplex
/* Calculating different nMaxEdit for ::lPicComplex */
FOR nFor := ::nPos TO nMaxEdit
IF !::IsEditable( nFor )
EXIT
ENDIF
NEXT
nMaxEdit := nFor
::cBuffer := Left( SubStr( ::cBuffer, 1, ::nPos - 1 ) + cChar +;
SubStr( ::cBuffer, ::nPos, nMaxEdit - 1 - ::nPos ) +;
SubStr( ::cBuffer, nMaxEdit ), ::nMaxLen )
ELSE
::cBuffer := Left( SubStr( ::cBuffer, 1, ::nPos - 1 ) + cChar + SubStr( ::cBuffer, ::nPos ), ::nMaxEdit )
ENDIF
::lChanged := .T.
::rightLow()
ENDIF
ENDIF
::display()
ENDIF
RETURN Self
METHOD right() CLASS Get
IF ::hasFocus .AND. ;
::rightLow()
::lSuppDisplay := .T.
::display()
ENDIF
RETURN Self
METHOD left() CLASS Get
IF ::hasFocus .AND. ;
::leftLow()
::lSuppDisplay := .T.
::display()
ENDIF
RETURN Self
METHOD wordLeft() CLASS Get
LOCAL nPos
IF ::hasFocus
::lClear := .F.
IF ::nPos == ::FirstEditable()
::typeOut := .T.
ELSE
::typeOut := .F.
nPos := ::nPos - 1
DO WHILE nPos > 0
IF SubStr( ::cBuffer, nPos, 1 ) == " "
DO WHILE nPos > 0 .AND. SubStr( ::cBuffer, nPos, 1 ) == " "
nPos--
ENDDO
DO WHILE nPos > 0 .AND. !( SubStr( ::cBuffer, 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
::lSuppDisplay := .T.
::display()
ENDIF
ENDIF
RETURN Self
METHOD wordRight() CLASS Get
LOCAL nPos
IF ::hasFocus
::lClear := .F.
IF ::nPos == ::nMaxEdit
::typeOut := .T.
ELSE
::typeOut := .F.
nPos := ::nPos + 1
DO WHILE nPos <= ::nMaxEdit
IF SubStr( ::cBuffer, nPos, 1 ) == " "
DO WHILE nPos <= ::nMaxEdit .AND. SubStr( ::cBuffer, nPos, 1 ) == " "
nPos++
ENDDO
EXIT
ENDIF
nPos++
ENDDO
IF nPos > ::nMaxEdit
nPos := ::nMaxEdit
ENDIF
IF nPos <= ::nMaxEdit
::pos := nPos
ENDIF
::lSuppDisplay := .T.
::display()
ENDIF
ENDIF
RETURN Self
METHOD toDecPos() CLASS Get
IF ::hasFocus
IF ::lClear
::delEnd()
ENDIF
::cBuffer := ::PutMask( ::unTransform(), .F. )
::pos := ::decPos
::lChanged := .T.
IF ::type == "N" .AND. ::lMinus .AND. ::unTransform() == 0
::backSpace()
::overStrike("-")
ENDIF
::display()
ENDIF
RETURN Self
METHOD backSpace() CLASS Get
IF ::hasFocus .AND. ;
::backSpaceLow()
::display()
ENDIF
RETURN Self
METHOD delete() CLASS Get
IF ::hasFocus
::deleteLow()
::display()
ENDIF
RETURN Self
METHOD delEnd() CLASS Get
LOCAL nPos
IF ::hasFocus
nPos := ::nPos
::pos := ::nMaxEdit
::deleteLow()
DO WHILE ::nPos > nPos
::backSpaceLow()
ENDDO
::display()
ENDIF
RETURN Self
METHOD delLeft() CLASS Get
::leftLow()
::deleteLow()
::right()
RETURN Self
METHOD delRight() CLASS Get
::rightLow()
::deleteLow()
::left()
RETURN Self
/* ::wordLeft()
::delWordRight() */
METHOD delWordLeft() CLASS Get
IF ::hasFocus
IF !( SubStr( ::cBuffer, ::nPos, 1 ) == " " )
IF SubStr( ::cBuffer, ::nPos - 1, 1 ) == " "
::backSpaceLow()
ELSE
::wordRight()
::left()
ENDIF
ENDIF
IF SubStr( ::cBuffer, ::nPos, 1 ) == " "
::deleteLow()
ENDIF
DO WHILE ::nPos > 1 .AND. !( SubStr( ::cBuffer, ::nPos - 1, 1 ) == " " )
::backSpaceLow()
ENDDO
::display()
ENDIF
RETURN Self
METHOD delWordRight() CLASS Get
IF ::hasFocus
::lClear := .F.
IF ::nPos == ::nMaxEdit
::typeOut := .T.
ELSE
::typeOut := .F.
DO WHILE ::nPos <= ::nMaxEdit .AND. !( SubStr( ::cBuffer, ::nPos, 1 ) == " " )
::deleteLow()
ENDDO
IF ::nPos <= ::nMaxEdit
::deleteLow()
ENDIF
::display()
ENDIF
ENDIF
RETURN Self
/* The METHOD ColorSpec and VAR 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 nClrUns
LOCAL nClrOth
LOCAL cClrOth
IF PCount() == 0
RETURN ::cColorSpec
ENDIF
IF ISCHARACTER( cColorSpec )
#ifdef HB_COMPAT_C53
::cColorSpec := hb_NToColor( nClrUns := Max( hb_ColorToN( hb_ColorIndex( cColorSpec, GET_CLR_UNSELECTED ) ), 0 ) ) +;
"," + hb_NToColor( iif( ( nClrOth := hb_ColorToN( cClrOth := hb_ColorIndex( cColorSpec, GET_CLR_ENHANCED ) ) ) != -1, nClrOth, nClrUns ) ) +;
"," + hb_NToColor( iif( ( nClrOth := hb_ColorToN( cClrOth := hb_ColorIndex( cColorSpec, GET_CLR_CAPTION ) ) ) != -1, nClrOth, nClrUns ) ) +;
"," + hb_NToColor( iif( ( nClrOth := hb_ColorToN( cClrOth := hb_ColorIndex( cColorSpec, GET_CLR_ACCEL ) ) ) != -1, nClrOth, nClrUns ) )
#else
::cColorSpec := hb_NToColor( nClrUns := Max( hb_ColorToN( hb_ColorIndex( cColorSpec, GET_CLR_UNSELECTED ) ), 0 ) ) +;
"," + hb_NToColor( iif( ( nClrOth := hb_ColorToN( cClrOth := hb_ColorIndex( cColorSpec, GET_CLR_ENHANCED ) ) ) != -1, nClrOth, nClrUns ) )
#endif
/* NOTE: CA-Cl*pper oddity. [vszakats] */
ELSEIF ValType( cColorSpec ) $ "UNDBA"
RETURN NIL
#ifdef HB_COMPAT_C53
/* NOTE: This code doesn't seem to make any sense, but seems to
replicate some original C5.3 behaviour. */
ELSE
IF Set( _SET_INTENSITY )
::cColorSpec := hb_ColorIndex( SetColor(), CLR_UNSELECTED ) + "," +;
hb_ColorIndex( SetColor(), CLR_ENHANCED ) + "," +;
hb_ColorIndex( SetColor(), CLR_STANDARD ) + "," +;
hb_ColorIndex( SetColor(), CLR_BACKGROUND )
ELSE
::cColorSpec := hb_ColorIndex( SetColor(), CLR_STANDARD ) + "," +;
hb_ColorIndex( SetColor(), CLR_STANDARD ) + "," +;
hb_ColorIndex( SetColor(), CLR_STANDARD ) + "," +;
hb_ColorIndex( SetColor(), CLR_STANDARD )
ENDIF
#endif
ENDIF
RETURN cColorSpec
METHOD pos( nPos ) CLASS Get
LOCAL tmp
IF PCount() == 0
RETURN ::nPos
ENDIF
IF ISNUMBER( nPos )
nPos := Int( nPos )
IF ::hasFocus
DO CASE
CASE nPos > ::nMaxLen
::nPos := iif( ::nMaxLen == 0, 1, ::nMaxLen )
::typeOut := .T.
CASE nPos > 0
/* NOTE: CA-Cl*pper has a bug where negative nPos value will be translated to 16bit unsigned int,
so the behaviour will be different in this case. [vszakats] */
FOR tmp := nPos TO ::nMaxLen
IF ::IsEditable( tmp )
::nPos := tmp
RETURN nPos
ENDIF
NEXT
FOR tmp := nPos - 1 TO 1 STEP -1
IF ::IsEditable( tmp )
::nPos := tmp
RETURN nPos
ENDIF
NEXT
::nPos := ::nMaxLen + 1
::typeOut := .T.
ENDCASE
ENDIF
RETURN nPos
ENDIF
RETURN 0
/* The METHOD Picture and VAR 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
LOCAL nAt
LOCAL nFor
LOCAL cNum
IF PCount() > 0
IF cPicture != NIL
::cPicture := cPicture
::nPicLen := NIL
::cPicFunc := ""
::cPicMask := ""
::lPicBlankZero := .F.
IF ISCHARACTER( cPicture )
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 "D" $ ::cPicFunc
::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" )
ENDIF
IF ( nAt := At( "S", ::cPicFunc ) ) > 0
FOR nFor := nAt + 1 TO Len( ::cPicFunc )
IF IsDigit( SubStr( ::cPicFunc, nFor, 1 ) )
cNum += SubStr( ::cPicFunc, nFor, 1 )
ELSE
EXIT
ENDIF
NEXT
IF Val( cNum ) > 0
::nPicLen := Val( cNum )
ENDIF
::cPicFunc := SubStr( ::cPicFunc, 1, nAt - 1 ) + SubStr( ::cPicFunc, nFor )
ENDIF
IF "Z" $ ::cPicFunc
::lPicBlankZero := .T.
::cPicFunc := StrTran( ::cPicFunc, "Z", "" )
ENDIF
IF ::cPicFunc == "@"
::cPicFunc := ""
ENDIF
ELSE
::cPicMask := cPicture
ENDIF
IF ::cType == "D"
::cPicMask := LTrim( ::cPicMask )
ENDIF
ENDIF
ENDIF
/* Generate default picture mask if not specified. */
IF Empty( ::cPicMask ) .OR. ::cPicture == NIL
DO CASE
CASE ::cType == "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 ::cType == "N"
cNum := Str( ::xVarGet )
IF ( nAt := At( ".", cNum ) ) > 0
::cPicMask := Replicate( "9", nAt - 1 ) + "."
::cPicMask += Replicate( "9", Len( cNum ) - Len( ::cPicMask ) )
ELSE
::cPicMask := Replicate( "9", Len( cNum ) )
ENDIF
CASE ::cType == "C" .AND. ::cPicFunc == "@9"
::cPicMask := Replicate( "9", Len( ::xVarGet ) )
::cPicFunc := ""
ENDCASE
ENDIF
/* To verify if it has non-modifiable embedded characters in the group. */
::lPicComplex := .F.
IF ! Empty( ::cPicMask )
FOR nFor := 1 TO Len( ::cPicMask )
IF !( SubStr( ::cPicMask, nFor, 1 ) $ "!ANX9#" )
::lPicComplex := .T.
EXIT
ENDIF
NEXT
ENDIF
ENDIF
RETURN ::cPicture
METHOD PutMask( xValue, lEdit ) CLASS Get
LOCAL cChar
LOCAL cBuffer
LOCAL cPicFunc := ::cPicFunc
LOCAL cPicMask := ::cPicMask
LOCAL nFor
LOCAL nNoEditable := 0
DEFAULT lEdit TO ::hasFocus
IF !( ValType( xValue ) $ "CNDL" )
xValue := ""
ENDIF
IF ::hasFocus
cPicFunc := StrTran( cPicfunc, "B", "" )
IF cPicFunc == "@"
cPicFunc := ""
ENDIF
ENDIF
IF lEdit .AND. ::lEdit
IF "*" $ cPicMask .OR. ;
"$" $ cPicMask
cPicMask := StrTran( StrTran( cPicMask, "*", "9" ), "$", "9" )
ENDIF
ENDIF
cBuffer := Transform( xValue, ;
iif( Empty( cPicFunc ), ;
iif( ::lPicBlankZero .AND. !::hasFocus, "@Z ", "" ), ;
cPicFunc + iif( ::lPicBlankZero .AND. !::hasFocus, "Z" , "" ) + " " ) ;
+ cPicMask )
IF ::cType == "N"
IF ( "(" $ cPicFunc .OR. ")" $ cPicFunc ) .AND. xValue >= 0
cBuffer += " "
ENDIF
IF ( ( "C" $ cPicFunc .AND. xValue < 0 ) .OR.;
( "X" $ cPicFunc .AND. xValue >= 0 ) ) .AND.;
!( "X" $ cPicFunc .AND. "C" $ cPicFunc )
cBuffer += " "
ENDIF
::lMinusPrinted := ( xValue < 0 )
ENDIF
::nMaxLen := Len( cBuffer )
::nMaxEdit := ::nMaxLen
IF lEdit .AND. ::cType == "N" .AND. ! Empty( cPicMask )
FOR nFor := 1 TO ::nMaxLen
cChar := SubStr( cPicMask, nFor, 1 )
IF cChar $ ",." .AND. SubStr( cBuffer, nFor, 1 ) $ ",." // " " TOFIX
IF "E" $ cPicFunc
cChar := IIF( cChar == ",", ".", "," )
ENDIF
cBuffer := SubStr( cBuffer, 1, nFor - 1 ) + cChar + SubStr( cBuffer, nFor + 1 )
ENDIF
NEXT
IF ::lEdit .AND. Empty( xValue )
cBuffer := StrTran( cBuffer, "0", " " )
ENDIF
ENDIF
IF ::cType == "N"
IF "(" $ ::cPicFunc .OR. ")" $ ::cPicFunc
::nMaxEdit--
ENDIF
IF "C" $ ::cPicFunc .OR. "X" $ ::cPicFunc
::nMaxEdit -= 3
ENDIF
ENDIF
IF ::cType == "D" .AND. ::badDate
cBuffer := ::cBuffer
ENDIF
::nMaxLen := Len( cBuffer )
RETURN cBuffer
METHOD unTransform() CLASS Get
LOCAL cBuffer
LOCAL xValue
LOCAL nFor
LOCAL lMinus
LOCAL lHasDec
IF ::hasFocus
cBuffer := ::cBuffer
IF ISCHARACTER( cBuffer )
DO CASE
CASE ::cType == "C"
IF "R" $ ::cPicFunc
xValue := ""
FOR nFor := 1 TO Len( ::cPicMask )
IF SubStr( ::cPicMask, nFor, 1 ) $ "ANX9#!LY"
xValue += SubStr( cBuffer, nFor, 1 )
ENDIF
NEXT
ELSE
xValue := cBuffer
ENDIF
CASE ::cType == "N"
lMinus := .F.
IF "X" $ ::cPicFunc
IF Right( cBuffer, 2 ) == "DB"
lMinus := .T.
ENDIF
ENDIF
IF !lMinus
FOR nFor := 1 TO ::nMaxLen
IF ::IsEditable( nFor ) .AND. IsDigit( SubStr( cBuffer, nFor, 1 ) )
EXIT
ENDIF
IF SubStr( cBuffer, nFor, 1 ) $ "-(" .AND. !( SubStr( cBuffer, nFor, 1 ) == SubStr( ::cPicMask, nFor, 1 ) )
lMinus := .T.
EXIT
ENDIF
NEXT
ENDIF
cBuffer := Space( ::FirstEditable() - 1 ) + SubStr( cBuffer, ::FirstEditable(), ::LastEditable() - ::FirstEditable() + 1 )
IF "D" $ ::cPicFunc
FOR nFor := ::FirstEditable() TO ::LastEditable()
IF !::IsEditable( nFor )
cBuffer := Left( cBuffer, nFor - 1 ) + Chr( 1 ) + SubStr( cBuffer, nFor + 1 )
ENDIF
NEXT
ELSE
IF "E" $ ::cPicFunc
cBuffer := Left( cBuffer, ::FirstEditable() - 1 ) +;
StrTran( StrTran( SubStr( cBuffer, ::FirstEditable(), ::LastEditable() - ::FirstEditable() + 1 ), ".", " " ), ",", "." ) +;
SubStr( cBuffer, ::LastEditable() + 1 )
ELSE
cBuffer := Left( cBuffer, ::FirstEditable() - 1 ) +;
StrTran( SubStr( cBuffer, ::FirstEditable(), ::LastEditable() - ::FirstEditable() + 1 ), ",", " " ) +;
SubStr( cBuffer, ::LastEditable() + 1 )
ENDIF
lHasDec := .F.
FOR nFor := ::FirstEditable() TO ::LastEditable()
IF ::IsEditable( nFor )
IF lHasDec .AND. SubStr( cBuffer, nFor, 1 ) == " "
cBuffer := Left( cBuffer, nFor - 1 ) + "0" + SubStr( cBuffer, nFor + 1 )
ENDIF
ELSE
IF SubStr( cBuffer, nFor, 1 ) == "."
lHasDec := .T.
ELSE
cBuffer := Left( cBuffer, nFor - 1 ) + Chr( 1 ) + SubStr( cBuffer, nFor + 1 )
ENDIF
ENDIF
NEXT
ENDIF
cBuffer := StrTran( cBuffer, Chr( 1 ), "" )
cBuffer := StrTran( cBuffer, "$", " " )
cBuffer := StrTran( cBuffer, "*", " " )
cBuffer := StrTran( cBuffer, "-", " " )
cBuffer := StrTran( cBuffer, "(", " " )
cBuffer := StrTran( cBuffer, ")", " " )
cBuffer := PadL( StrTran( cBuffer, " ", "" ), Len( cBuffer ) )
IF lMinus
FOR nFor := 1 TO Len( cBuffer )
IF IsDigit( SubStr( cBuffer, nFor, 1 ) ) .OR. SubStr( cBuffer, nFor, 1 ) == "."
EXIT
ENDIF
NEXT
nFor--
IF nFor > 0
cBuffer := Left( cBuffer, nFor - 1 ) + "-" + SubStr( cBuffer, nFor + 1 )
ELSE
cBuffer := "-" + cBuffer
ENDIF
ENDIF
xValue := Val( cBuffer )
CASE ::cType == "L"
cBuffer := Upper( cBuffer )
xValue := "T" $ cBuffer .OR. ;
"Y" $ cBuffer .OR. ;
hb_LangMessage( HB_LANG_ITEM_BASE_TEXT + 1 ) $ cBuffer
CASE ::cType == "D"
IF "E" $ ::cPicFunc
cBuffer := SubStr( cBuffer, 4, 3 ) + SubStr( cBuffer, 1, 3 ) + SubStr( cBuffer, 7 )
ENDIF
xValue := CToD( cBuffer )
ENDCASE
ELSE
::lClear := .F.
::decPos := 0
::nPos := 0
::typeOut := .F.
ENDIF
ENDIF
RETURN xValue
METHOD type() CLASS Get
RETURN ::cType := ValType( iif( ::hasFocus, ::xVarGet, ::varGet() ) )
/* The METHOD Block and VAR 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 PCount() == 0 .OR. bBlock == NIL
RETURN ::bBlock
ENDIF
::bBlock := bBlock
::xVarGet := ::original
::cType := ValType( ::xVarGet )
RETURN bBlock
METHOD firstEditable() CLASS Get
LOCAL nFor
IF ::nMaxLen != NIL
IF ::IsEditable( 1 )
RETURN 1
ENDIF
FOR nFor := 2 TO ::nMaxLen
IF ::IsEditable( nFor )
RETURN nFor
ENDIF
NEXT
ENDIF
RETURN 0
METHOD lastEditable() CLASS Get
LOCAL nFor
IF ::nMaxLen != NIL
FOR nFor := ::nMaxLen TO 1 STEP -1
IF ::IsEditable( nFor )
RETURN nFor
ENDIF
NEXT
ENDIF
RETURN 0
METHOD badDate() CLASS Get
LOCAL xValue
RETURN ::hasFocus .AND. ;
::type == "D" .AND. ;
( xValue := ::unTransform() ) == hb_SToD( "" ) .AND. ;
!( ::cBuffer == Transform( xValue, ::cPicture ) )
#ifdef HB_C52_UNDOC
METHOD reform() CLASS Get
IF ::hasFocus
::cBuffer := ::PutMask( ::unTransform(), .F. )
::nDispLen := iif( ::nPicLen == NIL, ::nMaxLen, ::nPicLen ) // ; ?
ENDIF
RETURN Self
#endif
#ifdef HB_COMPAT_C53
METHOD hitTest( nMRow, nMCol ) CLASS Get
IF ISOBJECT( ::oControl )
RETURN ::oControl:hitTest( nMRow, nMCol )
ELSE
DO CASE
CASE nMRow == ::nRow .AND. ;
nMCol >= ::nCol .AND. ;
nMCol < ::nCol + iif( ::nDispLen == NIL, 0, ::nDispLen )
RETURN HTCLIENT
CASE nMRow == ::nCapRow .AND. ;
nMCol >= ::nCapCol .AND. ;
nMCol < ::nCapCol + Len( ::cCaption ) /* NOTE: C5.3 doesn't care about the shortcut key. */
RETURN HTCAPTION
ENDCASE
ENDIF
RETURN HTNOWHERE
METHOD control( oControl ) CLASS Get
IF PCount() == 1 .AND. ( oControl == NIL .OR. ISOBJECT( oControl ) )
::oControl := oControl
ENDIF
RETURN ::oControl
METHOD caption( cCaption ) CLASS Get
IF ISCHARACTER( cCaption )
::cCaption := cCaption
ENDIF
RETURN ::cCaption
METHOD capRow( nCapRow ) CLASS Get
IF ISNUMBER( nCapRow )
::nCapRow := Int( nCapRow )
ENDIF
RETURN ::nCapRow
METHOD capCol( nCapCol ) CLASS Get
IF ISNUMBER( nCapCol )
::nCapCol := Int( nCapCol )
ENDIF
RETURN ::nCapCol
METHOD message( cMessage ) CLASS Get
IF ISCHARACTER( cMessage )
::cMessage := cMessage
ENDIF
RETURN ::cMessage
#endif
#ifdef HB_COMPAT_XPP
/* NOTE: Not tested or compared to XBase++. [vszakats] */
/* TOFIX: To make it work when @S was used. [vszakats] */
METHOD posInBuffer( nRow, nCol ) CLASS Get
IF ::hasFocus .AND. ;
nRow == ::nRow .AND. ;
nCol >= ::nCol + ::nPos - 1 .AND. ;
nCol <= ::nCol + ::nDispLen
RETURN nCol - ::nCol + 1
ENDIF
RETURN 0
#endif
/* ------------------------------------------------------------------------- */
METHOD rightLow() CLASS Get
LOCAL nPos
::typeOut := .F.
::lClear := .F.
IF ::nPos == ::nMaxEdit
::typeOut := .T.
RETURN .F.
ENDIF
nPos := ::nPos + 1
DO WHILE ! ::IsEditable( nPos ) .AND. nPos <= ::nMaxEdit
nPos++
ENDDO
IF nPos <= ::nMaxEdit
::pos := nPos
ELSE
::typeOut := .T.
ENDIF
RETURN .T.
METHOD leftLow() CLASS Get
LOCAL nPos
::typeOut := .F.
::lClear := .F.
IF ::nPos == ::FirstEditable()
::typeOut := .T.
RETURN .F.
ENDIF
nPos := ::nPos - 1
DO WHILE ! ::IsEditable( nPos ) .AND. nPos > 0
nPos--
ENDDO
IF nPos > 0
::pos := nPos
ELSE
::typeOut := .T.
ENDIF
RETURN .T.
METHOD backSpaceLow() CLASS Get
LOCAL nPos
LOCAL nMinus
nPos := ::nPos
IF nPos > 1 .AND. nPos == ::FirstEditable() .AND. ::lMinus2
/* To delete the parenthesis (negative indicator) in a non editable position */
nMinus := At( "(", SubStr( ::cBuffer, 1, nPos - 1 ) )
IF nMinus > 0 .AND. !( SubStr( ::cPicMask, nMinus, 1 ) == "(" )
::cBuffer := SubStr( ::cBuffer, 1, nMinus - 1 ) + " " +;
SubStr( ::cBuffer, nMinus + 1 )
::lEdit := .T.
::lChanged := .T.
RETURN .T.
ENDIF
ENDIF
::left()
IF ::nPos < nPos
::deleteLow()
RETURN .T.
ENDIF
RETURN .F.
METHOD deleteLow() CLASS Get
LOCAL nMaxLen := ::nMaxLen
LOCAL n
::lClear := .F.
::lEdit := .T.
IF ::lPicComplex
/* Calculating different nMaxLen for ::lPicComplex */
FOR n := ::nPos TO nMaxLen
IF !::IsEditable( n )
EXIT
ENDIF
NEXT
nMaxLen := n - 1
ENDIF
IF ::cType == "N" .AND. SubStr( ::cBuffer, ::nPos, 1 ) $ "(-"
::lMinus2 := .F.
ENDIF
::cBuffer := PadR( SubStr( ::cBuffer, 1, ::nPos - 1 ) + ;
SubStr( ::cBuffer, ::nPos + 1, nMaxLen - ::nPos ) + " " +;
SubStr( ::cBuffer, nMaxLen + 1 ), ::nMaxLen )
::lChanged := .T.
RETURN NIL
METHOD DeleteAll() CLASS Get
LOCAL xValue
IF ::hasFocus
::lEdit := .T.
DO CASE
CASE ::cType == "C"
xValue := Space( ::nMaxlen )
CASE ::cType == "N"
xValue := 0
::lMinus2 := .F.
CASE ::cType == "D"
xValue := CToD( "" )
CASE ::cType == "L"
xValue := .F.
ENDCASE
::cBuffer := ::PutMask( xValue )
::pos := ::FirstEditable()
ENDIF
RETURN Self
METHOD IsEditable( nPos ) CLASS Get
LOCAL cChar
IF Empty( ::cPicMask )
RETURN .T.
ENDIF
/* ; This odd behaviour helps to be more compatible with CA-Cl*pper in some rare situations.
xVar := 98 ; o := _GET_( xVar, "xVar" ) ; o:SetFocus() ; o:picture := "99999" ; o:UnTransform() -> result
We're still not 100% compatible in slighly different situations because the CA-Cl*pper
behaviour is pretty much undefined here. [vszakats] */
IF nPos > Len( ::cPicMask ) .AND. nPos <= ::nMaxLen
RETURN .T.
ENDIF
cChar := SubStr( ::cPicMask, nPos, 1 )
DO CASE
CASE ::cType == "C"
RETURN cChar $ "!ANX9#LY"
CASE ::cType == "N"
RETURN cChar $ "9#$*"
CASE ::cType == "D"
RETURN cChar == "9"
CASE ::cType == "L"
RETURN cChar $ "LY#" /* CA-Cl*pper 5.2 undocumented: # allow T,F,Y,N for Logical [ckedem] */
ENDCASE
RETURN .F.
METHOD Input( cChar ) CLASS Get
LOCAL cPic
DO CASE
CASE ::cType == "N"
DO CASE
CASE cChar == "-"
::lMinus2 := .T. /* The minus symbol can be written in any place */
::lMinus := .T.
CASE cChar $ ".,"
::toDecPos()
RETURN ""
CASE ! ( cChar $ "0123456789+" )
RETURN ""
ENDCASE
CASE ::cType == "D"
IF !( cChar $ "0123456789" )
RETURN ""
ENDIF
CASE ::cType == "L"
IF !( Upper( cChar ) $ "YNTF" )
RETURN ""
ENDIF
ENDCASE
IF ! Empty( ::cPicFunc )
cChar := Left( Transform( cChar, ::cPicFunc ), 1 ) /* Left needed for @D */
ENDIF
IF ! Empty( ::cPicMask )
cPic := SubStr( ::cPicMask, ::nPos, 1 )
// cChar := Transform( cChar, cPic )
// Above line eliminated because some get picture template symbols for
// numeric input not work in text input. eg: $ and *
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
IF !( ::cType == "N" ) .AND. cChar $ "-+"
cChar := ""
ENDIF
/* Clipper 5.2 undocumented: # allow T,F,Y,N for Logical [ckedem] */
CASE cPic == "L" .OR. ( cPic == "#" .AND. ::cType == "L" )
IF !( Upper( cChar ) $ "YNTF" + ;
hb_LangMessage( HB_LANG_ITEM_BASE_TEXT + 1 ) + ;
hb_LangMessage( HB_LANG_ITEM_BASE_TEXT + 2 ) )
cChar := ""
ENDIF
CASE cPic == "#"
IF ! IsDigit( cChar ) .AND. !( cChar == " " ) .AND. !( cChar $ ".+-" )
cChar := ""
ENDIF
CASE cPic == "Y"
IF !( Upper( cChar ) $ "YN" )
cChar := ""
ENDIF
CASE ( cPic == "$" .OR. cPic == "*" ) .AND. ::cType == "N"
IF ! IsDigit( cChar ) .AND. !( cChar == "-" )
cChar := ""
ENDIF
OTHERWISE
cChar := Transform( cChar, cPic )
ENDCASE
ENDIF
RETURN cChar
/* ------------------------------------------------------------------------- */
METHOD buffer( cBuffer ) CLASS Get
IF PCount() == 0
RETURN ::cBuffer
ENDIF
RETURN iif( ::hasFocus, ::cBuffer := cBuffer, cBuffer )
/* NOTE: In contrary to CA-Cl*pper docs, this var is assignable. [vszakats] */
METHOD changed( lChanged ) CLASS Get
IF PCount() == 0
RETURN ::lChanged
ENDIF
IF ISLOGICAL( lChanged )
RETURN iif( ::hasFocus, ::lChanged := lChanged, lChanged )
ENDIF
RETURN .F.
METHOD clear( lClear ) CLASS Get
IF PCount() == 0
RETURN ::lClear
ENDIF
IF ISLOGICAL( lClear )
RETURN iif( ::hasFocus, ::lClear := lClear, lClear )
ENDIF
RETURN .F.
METHOD minus( lMinus ) CLASS Get
IF PCount() == 0
RETURN ::lMinus
ENDIF
IF ISLOGICAL( lMinus )
RETURN iif( ::hasFocus, ::lMinus := lMinus, lMinus )
ENDIF
RETURN .F.
/* NOTE: CA-Cl*pper has a bug where negative nRow value will be translated to 16bit unsigned int,
so the behaviour will be different in this case. [vszakats] */
METHOD row( nRow ) CLASS Get
IF PCount() > 0
::nRow := iif( ISNUMBER( nRow ), Int( nRow ), 0 )
ENDIF
RETURN ::nRow
/* NOTE: CA-Cl*pper has a bug where negative nCol value will be translated to 16bit unsigned int,
so the behaviour will be different in this case. [vszakats] */
METHOD col( nCol ) CLASS Get
IF PCount() > 0
::nCol := iif( ISNUMBER( nCol ), Int( nCol ), 0 )
ENDIF
RETURN ::nCol
METHOD name( cName ) CLASS Get
IF PCount() > 0 .AND. cName != NIL
::cName := cName
ENDIF
RETURN ::cName
#ifdef HB_EXTENSION
METHOD hideInput( lHideInput ) CLASS Get
IF lHideInput != NIL
::lHideInput := __eInstVar53( Self, "HIDEINPUT", lHideInput, "L", 1001 )
ENDIF
RETURN ::lHideInput
METHOD style( cStyle ) CLASS Get
IF cStyle != NIL
::cStyle := __eInstVar53( Self, "STYLE", cStyle, "C", 1001, {|| Len( cStyle ) == 1 } )
ENDIF
RETURN ::cStyle
#endif
/* ------------------------------------------------------------------------- */
METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS Get
DEFAULT nRow TO Row()
DEFAULT nCol TO Col() + iif( Set( _SET_DELIMITERS ), 1, 0 )
DEFAULT cVarName TO ""
DEFAULT bVarBlock TO iif( ISCHARACTER( cVarName ), MemvarBlock( cVarName ), NIL )
#ifdef HB_COMPAT_C53
DEFAULT cColorSpec TO hb_ColorIndex( SetColor(), CLR_UNSELECTED ) + "," +;
hb_ColorIndex( SetColor(), CLR_ENHANCED ) + "," +;
hb_ColorIndex( SetColor(), CLR_STANDARD ) + "," +;
iif( IsDefColor(), iif( Set( _SET_INTENSITY ), "W+/N", "W/N" ), hb_ColorIndex( SetColor(), CLR_BACKGROUND ) )
#else
DEFAULT cColorSpec TO hb_ColorIndex( SetColor(), CLR_UNSELECTED ) + "," +;
hb_ColorIndex( SetColor(), CLR_ENHANCED )
#endif
::nRow := nRow
::nCol := nCol
::bBlock := bVarBlock
::cName := cVarName
::picture := cPicture
::colorSpec := cColorSpec
RETURN Self
Reference in New Issue View Git Blame Copy Permalink