From c1edfbcdbe52b17a1cbfaeb5672dc86c1e9b4c40 Mon Sep 17 00:00:00 2001 From: Ignacio Ortiz de Zuniga Date: Fri, 21 Jan 2000 11:54:05 +0000 Subject: [PATCH] 20000121 12:50 GMT+1 Ignacio Ortiz --- harbour/source/rtl/memoline.c | 3 +- harbour/source/rtl/tget.prg | 279 ++++++++++++++++++++++++++------ harbour/source/rtl/tgetlist.prg | 3 +- 3 files changed, 229 insertions(+), 56 deletions(-) diff --git a/harbour/source/rtl/memoline.c b/harbour/source/rtl/memoline.c index 32d3a3bea3..fe38c1753e 100644 --- a/harbour/source/rtl/memoline.c +++ b/harbour/source/rtl/memoline.c @@ -70,7 +70,7 @@ HARBOUR HB_MEMOLINE( void ) case HB_CHAR_LF: ulCurLength = 0; ulLastSpace = 0; - ulLineEnd = ulPos - 2; + ulLineEnd = max( ulPos - 2, ulLineBegin ) ; ulLines++; if( ulLines < ulLineNumber ) { @@ -152,3 +152,4 @@ HARBOUR HB_MEMOLINE( void ) else hb_retc( "" ); } + diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index 9cfac73d18..b51acb48bc 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -1,7 +1,3 @@ -/* - * $Id$ - */ - /* * Harbour Project source code: * Get Class @@ -37,11 +33,9 @@ #include "color.ch" #include "common.ch" #include "setcurs.ch" - -/* TODO: Scrolling buffer support. */ -/* TOFIX: Handling of date. */ -/* TODO: Missing methods. */ -/* TOFIX: WordLeft(), WordRight() methods */ +#include "getexit.ch" +#include "inkey.ch" +#include "set.ch" #define GET_CLR_UNSELECTED 0 #define GET_CLR_ENHANCED 1 @@ -113,12 +107,16 @@ CLASS TGet // 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 ) + METHOD SetPos() INLINE SetPos( ::Row, ::Col + ::Pos - ::nDispPos ) + ENDCLASS //---------------------------------------------------------------------------// @@ -130,6 +128,8 @@ METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS TGet local nFor local cNum + cNum := "" + DEFAULT nRow TO Row() DEFAULT nCol TO Col() DEFAULT cVarName TO "" @@ -158,6 +158,8 @@ METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS TGet ::SubScript := Nil ::Type := Valtype( ::Original ) ::TypeOut := .f. + ::nDispPos := 1 + ::nOldPos := 0 // Existe function en picture @@ -174,8 +176,11 @@ METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS TGet 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 ) if ::cPicFunc == "@" ::cPicFunc := "" @@ -199,8 +204,11 @@ METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS TGet ::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" @@ -230,18 +238,34 @@ METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS TGet Next endif - ::buffer := ::PutMask( ::Original, .f. ) + ::buffer := ::PutMask( ::Original, .f. ) + ::nMaxLen := len(::buffer) + + if ::nDispLen == Nil + ::nDispLen := ::nMaxLen + endif return Self //---------------------------------------------------------------------------// -METHOD Display() CLASS TGet +METHOD Display(lForced) CLASS TGet local nOldCursor := SetCursor( SC_NONE ) - DispOutAt( ::Row, ::Col,; - ::buffer, hb_ColorIndex( ::ColorSpec, iif( ::HasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ) ) + DEFAULT lForced TO .t. + + if ::HasScroll() .and. ::Pos != Nil + ::nDispPos := Max( 1, Min( ::Pos - Int( ::nDispLen / 2 ), ::nMaxLen - ::nDispLen + 1 ) ) + endif + + if 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 SetCursor( nOldCursor ) @@ -261,7 +285,8 @@ METHOD End() CLASS TGet ::Pos := ::nMaxLen endif ::Clear := .f. - SetPos( ::Row, ::Col + ::Pos - 1 ) + ::Display(.f.) + ::SetPos() endif return nil @@ -273,7 +298,9 @@ METHOD Home() CLASS TGet if ::HasFocus ::Pos := 1 ::Clear := .f. - SetPos( ::Row, ::Col + ::Pos - 1 ) + //SetPos( ::Row, ::Col + ::Pos - 1 ) + ::Display(.f.) + ::SetPos() endif return nil @@ -323,13 +350,13 @@ METHOD SetFocus() CLASS TGet endif if ::type == "D" - ::BadDate := ( At( " ", DToC( CToD( ::buffer ) ) ) != 0 ) + ::BadDate := ( Dtoc( Ctod( ::buffer ) ) != ::buffer ) else ::BadDate := .f. endif ::Display() - SetPos( ::Row, ::Col + ::Pos - 1 ) + ::SetPos() return Self @@ -423,7 +450,7 @@ return xValue METHOD overstrike( cChar ) CLASS TGet if ::type == "N" .and. !::lEdit - ::pos := 1 + ::pos := 1 endif if ::Clear .and. ::pos == 1 @@ -433,18 +460,16 @@ METHOD overstrike( cChar ) CLASS TGet endif if !::lEdit - ::buffer := ::PutMask( ::VarGet(), .t. ) ::lEdit := .t. + endif - do while !::IsEditable( ::pos ) .and. ::pos <= ::nMaxLen - ::pos++ - enddo - - if ::pos > ::nMaxLen - ::pos := 1 - endif + do while !::IsEditable( ::pos ) .and. ::pos <= ::nMaxLen + ::pos++ + enddo + if ::pos > ::nMaxLen + ::pos := 1 endif cChar := ::Input( cChar ) @@ -460,13 +485,13 @@ METHOD overstrike( cChar ) CLASS TGet ::Right() if ::type == "D" - ::BadDate := ( At(" ", DToC( CToD( ::buffer ) ) ) != 0 ) + ::BadDate := ( Dtoc( Ctod( ::buffer ) ) != ::buffer ) else ::BadDate := .f. endif ::Display() - SetPos( ::Row, ::Col + iif( ::Pos != nil, ::Pos - 1, 0 ) ) + ::SetPos() return Self @@ -474,6 +499,10 @@ return Self METHOD Insert( cChar ) CLASS TGet + local cOver + local cTmp + local nPos + if ::type == "N" .and. !::lEdit ::pos := 1 endif @@ -489,26 +518,48 @@ METHOD Insert( cChar ) CLASS TGet ::lEdit := .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 - ::buffer := Left( SubStr( ::buffer, 1, ::Pos - 1 ) + cChar + SubStr( ::buffer, ::Pos ), ::nMaxLen ) + cOver := Substr( ::buffer, ::Pos, 1 ) + ::buffer := Substr( ::buffer, 1, ::Pos-1 ) + cChar + Substr( ::buffer, ::Pos+1 ) + nPos := ::Pos + 1 + + do while nPos <= ::nMaxLen + if ::IsEditable( nPos ) + cTmp := Substr( ::buffer, nPos, 1 ) + ::buffer := Substr( ::buffer, 1, nPos - 1 ) + cOver + Substr( ::buffer, nPos + 1 ) + cOver := cTmp + endif + nPos++ + enddo + ::Changed := ( ::unTransform() != ::Original ) ::Assign() ::Right() if ::type == "D" - ::BadDate := ( At( " ", DToC( CToD( ::buffer ) ) ) != 0 ) + ::BadDate := ( Dtoc( Ctod( ::buffer ) ) != ::buffer ) else ::BadDate := .f. endif ::Display() // Kwon,Oh-Chul - SetPos( ::Row, ::Col + iif( ::Pos != nil, ::Pos - 1, 0 ) ) + ::SetPos() return Self @@ -542,7 +593,8 @@ METHOD _Right() CLASS TGet ::TypeOut := .t. endif - SetPos( ::Row, ::Col + ::Pos - 1 ) + ::Display(.f.) + ::SetPos() return Self @@ -576,7 +628,8 @@ METHOD _Left() CLASS TGet ::TypeOut := .t. endif - SetPos( ::Row, ::Col + ::Pos - 1 ) + ::Display(.f.) + ::SetPos() return Self @@ -600,7 +653,19 @@ METHOD WordLeft() CLASS TGet nPos := ::Pos - 1 - do while SubStr( ::buffer, nPos, 1 ) != " " .and. nPos > 0 + 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 @@ -608,7 +673,8 @@ METHOD WordLeft() CLASS TGet ::Pos := nPos endif - SetPos( ::Row, ::Col + ::Pos - 1 ) + ::Display(.f.) + ::SetPos() return Self @@ -632,7 +698,13 @@ METHOD WordRight() CLASS TGet nPos := ::Pos + 1 - do while SubStr( ::buffer, nPos, 1 ) != " " .and. nPos <= ::nMaxLen + do while nPos <= ::nMaxLen + if SubStr( ::buffer, nPos, 1 ) == " " + do while nPos <= ::nMaxLen .and. SubStr( ::buffer, nPos, 1 ) == " " + nPos++ + Enddo + Exit + endif nPos++ Enddo @@ -640,7 +712,8 @@ METHOD WordRight() CLASS TGet ::Pos := nPos endif - SetPos( ::Row, ::Col + ::Pos - 1 ) + ::Display(.f.) + ::SetPos() return Self @@ -656,8 +729,8 @@ METHOD ToDecPos() CLASS TGet ::buffer := ::PutMask( ::UnTransform(), .t. ) ::pos := ::DecPos + 1 - ::Display() - SetPos( ::Row, ::Col + ::Pos - 1 ) + ::Display(.f.) + ::SetPos() return .t. @@ -694,6 +767,8 @@ return .f. METHOD Input( cChar ) CLASS TGet + local cPic + do case case ::type == "N" @@ -731,8 +806,29 @@ METHOD Input( cChar ) CLASS TGet cChar := Transform( cChar, ::cPicFunc ) endif + if !Empty( ::cPicMask ) - cChar := Transform( cChar, SubStr( ::cPicMask, ::pos, 1 ) ) + 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 ) + cChar := "" + endif + case cPic == "#" + if !IsDigit( cChar ) .and. cChar != " " .and. !( cChar$"+-" ) + cChar := "" + endif + end case endif return cChar @@ -751,6 +847,10 @@ METHOD PutMask( xValue, lEdit ) CLASS TGet DEFAULT xValue TO ::VarGet() DEFAULT lEdit TO ::HasFocus + if xValue == Nil + return "" + endif + cBuffer := Transform( xValue, Alltrim( ::cPicFunc + " " + ::cPicMask ) ) if lEdit .and. ::type == "N" .and. !Empty( ::cPicMask ) @@ -775,21 +875,25 @@ return cBuffer //---------------------------------------------------------------------------// -METHOD BackSpace() CLASS TGet +METHOD BackSpace( lDisplay ) CLASS TGet local nPos := ::Pos + DEFAULT lDisplay TO .t. + ::Left() if ::Pos < nPos - ::Delete() + ::Delete( lDisplay ) endif return Self //---------------------------------------------------------------------------// -METHOD _Delete() CLASS TGet +METHOD _Delete( lDisplay ) CLASS TGet + + DEFAULT lDisplay TO .t. do case case ::type == "C" @@ -818,8 +922,11 @@ METHOD _Delete() CLASS TGet endcase ::Assign() - ::Display() - SetPos( ::Row, ::Col + iif( ::Pos != nil, ::Pos - 1, 0 ) ) + + if lDisplay + ::Display() + ::SetPos() + endif return Self @@ -850,31 +957,99 @@ return Self METHOD DelEnd() CLASS TGet - /* TODO: Implement DelEnd() */ + local nPos := ::Pos + + if !::hasfocus + return Self + endif + + ::Pos := ::nMaxLen + + do while ::Pos > nPos + ::BackSpace(.f.) + enddo + + ::Display() + ::SetPos() return Self +//---------------------------------------------------------------------------// + METHOD DelLeft() CLASS TGet - /* TODO: Implement DelLeft() */ + ::Left() + ::Delete() + ::Right() return Self +//---------------------------------------------------------------------------// + METHOD DelRight() CLASS TGet - /* TODO: Implement DelRight() */ + ::Right() + ::Delete() + ::Left() return Self +//---------------------------------------------------------------------------// + METHOD DelWordLeft() CLASS TGet - /* TODO: Implement DelWordLeft() */ + 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() + ::SetPos() return Self +//---------------------------------------------------------------------------// + METHOD DelWordRight() CLASS TGet - /* TODO: Implement DelWordRight() */ + 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() + ::SetPos() return Self @@ -897,6 +1072,4 @@ function _GET_( uVar, cVarName, cPicture, bValid, bWhen, bSetGet ) oGet:PreBlock := bWhen oGet:PostBlock := bValid - return oGet - -//---------------------------------------------------------------------------// + return oGet \ No newline at end of file diff --git a/harbour/source/rtl/tgetlist.prg b/harbour/source/rtl/tgetlist.prg index fa5b764d0f..b5dd6c9591 100644 --- a/harbour/source/rtl/tgetlist.prg +++ b/harbour/source/rtl/tgetlist.prg @@ -300,7 +300,7 @@ METHOD GetPostValidate() CLASS TGetList endif if oGet:BadDate() - oGet:Home() + oGet:SetFocus() ::DateMsg() ::ShowScoreboard() return .f. @@ -522,4 +522,3 @@ FUNCTION ReadExit( lExit ) FUNCTION ReadInsert( lInsert ) RETURN Set( _SET_INSERT, lInsert ) -