diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 5f82efc9bd..34893b7863 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,24 @@ +2001-07-20 20:00 GMT -3 Luiz Rafael Culik + +source/rtl/checkbox.prg + *CheckBox Class Compatible with Ca-Clipper 5.3 + *source/rtl/getsys.prg + +Added the follow function For compatibility with Ca-Clipper 5.3: GUIReader(),GuiApplyKey(),GuiGetPreValidate(),GuiGetPostValidate() + *source/rtl/tget.prg + +Control and Message Data + *Source/rtl/tgetlist.prg + +Added the follow methods GUIReader(),GUIApplyKey(),GuiPreValidate(oGui),GuiPostValidate(oGui) + *utils/hbmake/hbmake.prg + *Applied patch provided By Dave Person + +tests/tstchbx.prg + *Small Test app for checkbox Class + *hb_slex.bc + makefile.bc + hb_slex.vc + makefile.vc + source/rtl/makefile + +added checkbox to dependency list + + 2001-07-20 22:45 UTC-0800 Ron Pinkas * include/hbexpra.c % Wrapped hb_compExprSetGetBlock() unneeded with simplex build, with #ifndef SIMPLEX diff --git a/harbour/contrib/libct/token1.c b/harbour/contrib/libct/token1.c index f9955f7ef0..a237d5659a 100644 --- a/harbour/contrib/libct/token1.c +++ b/harbour/contrib/libct/token1.c @@ -535,8 +535,7 @@ static void do_token1 (int iSwitch) * $FILES$ * Source is token1.c, library is ct3. * $SEEALSO$ - * TOKEN() NUMTOKEN() TOKENLOWER() - * TOKENUPPER() TOKENSEP() + * TOKEN(),NUMTOKEN(),TOKENLOWER(),TOKENUPPER(),TOKENSEP() * $END$ */ @@ -613,8 +612,7 @@ HB_FUNC (ATTOKEN) * $FILES$ * Source is token1.c, library is ct3. * $SEEALSO$ - * NUMTOKEN() ATTOKEN() TOKENLOWER() - * TOKENUPPER() TOKENSEP() + * NUMTOKEN(),ATTOKEN(),TOKENLOWER(),TOKENUPPER(),TOKENSEP() * $END$ */ @@ -653,8 +651,7 @@ HB_FUNC (TOKEN) * $FILES$ * Source is token1.c, library is ct3. * $SEEALSO$ - * TOKEN() ATTOKEN() TOKENLOWER() - * TOKENUPPER() TOKENSEP() + * TOKEN(),ATTOKEN(),TOKENLOWER(),TOKENUPPER(),TOKENSEP() * $END$ */ @@ -723,8 +720,7 @@ HB_FUNC (NUMTOKEN) * $FILES$ * Source is token1.c, library is ct3. * $SEEALSO$ - * TOKEN() NUMTOKEN() ATTOKEN() - * TOKENUPPER() TOKENSEP() CSETREF() + * TOKEN(),NUMTOKEN(),ATTOKEN(),TOKENUPPER(),TOKENSEP(),CSETREF() * $END$ */ @@ -794,8 +790,7 @@ HB_FUNC (TOKENLOWER) * $FILES$ * Source is token1.c, library is ct3. * $SEEALSO$ - * TOKEN() NUMTOKEN() ATTOKEN() - * TOKENLOWER() TOKENSEP() CSETREF() + * TOKEN(),NUMTOKEN(),ATTOKEN(),TOKENLOWER(),TOKENSEP(),CSETREF() * $END$ */ @@ -844,8 +839,7 @@ HB_FUNC (TOKENUPPER) * $FILES$ * Source is token1.c, library is ct3. * $SEEALSO$ - * TOKEN() NUMTOKEN() ATTOKEN() - * TOKENLOWER() TOKENUPPER() + * TOKEN(),NUMTOKEN(),ATTOKEN(),TOKENLOWER(),TOKENUPPER() * $END$ */ diff --git a/harbour/contrib/libct/wordrepl.c b/harbour/contrib/libct/wordrepl.c index b5364cbe07..fb1faeaf5e 100644 --- a/harbour/contrib/libct/wordrepl.c +++ b/harbour/contrib/libct/wordrepl.c @@ -116,8 +116,7 @@ * $FILES$ * Source is wordrepl.c, library is ct3. * $SEEALSO$ - * CHARREPL() RANGEREPL() POSREPL() - * CSETREF() CSETATMUPA() + * CHARREPL(),RANGEREPL(),POSREPL(),CSETREF(),CSETATMUPA() * $END$ */ diff --git a/harbour/hb_slex.bc b/harbour/hb_slex.bc index 806061b94f..34547bb0f8 100644 --- a/harbour/hb_slex.bc +++ b/harbour/hb_slex.bc @@ -290,6 +290,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\browdb.obj \ $(OBJ_DIR)\browdbx.obj \ $(OBJ_DIR)\browse.obj \ + $(OBJ_DIR)\checkbox.obj \ $(OBJ_DIR)\dbedit.obj \ $(OBJ_DIR)\dbdelim.obj \ $(OBJ_DIR)\dbsdf.obj \ @@ -1123,6 +1124,13 @@ $(OBJ_DIR)\browse.obj : $(OBJ_DIR)\browse.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\checkbox.c : $(RTL_DIR)\checkbox.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\checkbox.obj : $(OBJ_DIR)\checkbox.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\chrasc.obj : $(RTL_DIR)\chrasc.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/hb_slex.vc b/harbour/hb_slex.vc index 8a53f96bca..aaa49e53f5 100644 --- a/harbour/hb_slex.vc +++ b/harbour/hb_slex.vc @@ -219,6 +219,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\binnum.obj \ $(OBJ_DIR)\binnumx.obj \ $(OBJ_DIR)\box.obj \ + $(OBJ_DIR)\checkbox.obj \ $(OBJ_DIR)\chrasc.obj \ $(OBJ_DIR)\colorind.obj \ $(OBJ_DIR)\console.obj \ diff --git a/harbour/makefile.bc b/harbour/makefile.bc index 45689b9ad2..dd19ddc708 100644 --- a/harbour/makefile.bc +++ b/harbour/makefile.bc @@ -290,6 +290,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\browdb.obj \ $(OBJ_DIR)\browdbx.obj \ $(OBJ_DIR)\browse.obj \ + $(OBJ_DIR)\checkbox.obj \ $(OBJ_DIR)\dbedit.obj \ $(OBJ_DIR)\dbdelim.obj \ $(OBJ_DIR)\dbsdf.obj \ @@ -1121,6 +1122,14 @@ $(OBJ_DIR)\browse.obj : $(OBJ_DIR)\browse.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\checkbox.c : $(RTL_DIR)\checkbox.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\checkbox.obj : $(OBJ_DIR)\checkbox.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) $(ARFLAGS) -+$@,, + + $(OBJ_DIR)\chrasc.obj : $(RTL_DIR)\chrasc.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, @@ -2467,4 +2476,4 @@ $(OBJ_DIR)\prb_stak.c : $(HBMAKE_DIR)\prb_stak.prg $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ $(OBJ_DIR)\prb_stak.obj : $(OBJ_DIR)\prb_stak.c - $(CC) $(CLIBFLAGS) -o$@ $** \ No newline at end of file + $(CC) $(CLIBFLAGS) -o$@ $** diff --git a/harbour/makefile.vc b/harbour/makefile.vc index eb3396685e..2c585b24aa 100644 --- a/harbour/makefile.vc +++ b/harbour/makefile.vc @@ -219,6 +219,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\binnum.obj \ $(OBJ_DIR)\binnumx.obj \ $(OBJ_DIR)\box.obj \ + $(OBJ_DIR)\checkbox.obj \ $(OBJ_DIR)\chrasc.obj \ $(OBJ_DIR)\colorind.obj \ $(OBJ_DIR)\console.obj \ diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index bf761e2dde..d74bfb3c67 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -118,6 +118,7 @@ PRG_SOURCES=\ browdb.prg \ browdbx.prg \ browse.prg \ + checkbox.prg \ dbdelim.prg \ dbedit.prg \ dbsdf.prg \ diff --git a/harbour/source/rtl/checkbox.prg b/harbour/source/rtl/checkbox.prg new file mode 100644 index 0000000000..bbccfa139f --- /dev/null +++ b/harbour/source/rtl/checkbox.prg @@ -0,0 +1,223 @@ + +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CHECKBOX class + * + * Copyright 2000 Luiz Rafael Culik + * 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 "Common.ch" +#include "hbSetup.ch" +#ifdef HB_COMPAT_C53 + +FUNCTION CHECKBOX(nRow,nCol,cCaption) +Local cColor:='' +Local oClass + if ( ( ISNUMBER( nRow ) ) ) .and. ( ( ISNUMBER( nCol ) ) ) + oClass:=TClass():New("CHECKBOX") + if(!( ISCHARACTER( cCaption ) ) ) + cCaption := "" + endif + + oClass:AddData( "Buffer" , .f. ) + oClass:AddData( "Caption" , cCaption ) + oClass:AddData( "CapRow" , nRow ) + oClass:AddData( "CapCol" , nCol+3+1 ) + oClass:AddData( "Cargo" ) + oClass:AddData( "Col" , nCol ) + if ( !isdefcolor() ) + oClass:AddData( "ColorSpec" ,"W/N,W+/N,W/N,W+/N" ) + else + cColor := SetColor() + oClass:AddData( "ColorSpec" , __guicolor(cColor, 5) + "," + ; + __guicolor(cColor, 2) + "," + __guicolor(cColor, 1) + ; + "," + __guicolor(cColor, 4)) + endif + + oClass:AddData( "FBlock" ) + oClass:AddData( "HasFocus" , .f. ) + oClass:AddData( "Message" , "" ) + oClass:AddData( "Row" , nRow ) + oClass:AddData( "SBlock" ) + oClass:AddData( "Style" , "[û ]" ) + oClass:AddData( "lCursor" ) + oClass:AddData( "Typeout" , .f. ) + + oClass:AddMethod( "SetFocus()" , @SetFocus() ) + oClass:AddMethod( "Select()" , @_Select() ) + oClass:AddMethod( "KillFocus()" , @KillFocus() ) + oClass:AddMethod( "Display()" , @DisPlay() ) + oClass:Create() + else + return nil + endif + +return oClass:Instance() + +STATIC Function SetFocus() + Local Self := QSelf() + if ( !::HasFocus .AND. ISBLOCK( ( ::lCursor := setcursor(0), ; + ::HasFocus := .T., ::display(), ::FBlock ) ) ) + eval(::FBlock) + endif + RETURN Self + +STATIC Function _Select(lState) + + Local Self := QSelf() + local lStatus := ::Buffer + if ( ISLOGICAL( lState ) ) + ::Buffer := lState + else + ::Buffer := !::Buffer + endif + if ( lStatus != ::Buffer .AND. ISBLOCK( ( ::display(), ; + ::SBlock ) ) ) + eval(::SBlock) + endif + RETURN Self + +STATIC Function KillFocus() + Local Self := QSelf() + if ( ::HasFocus ) + ::HasFocus := .F. + if ( ISBLOCK( ::FBlock ) ) + eval(::FBlock) + endif + qself():display() + setcursor(::lCursor) + endif + RETURN Self + + +STATIC Function Display() + + Local Self := QSelf() + local cColor := SetColor(), nCurRow:= Row(), nCurCol:= Col(), ; + cOldStyle := ::Style, cCaption, nPos + + dispbegin() + if ( ::HasFocus ) + set color to (__guicolor(::ColorSpec, 2)) + else + set color to (__guicolor(::ColorSpec, 1)) + endif + + SetPos(::Row, ::Col + 1) + if ( ::Buffer ) + ?? SubStr(cOldStyle, 2, 1) + else + ?? SubStr(cOldStyle, 3, 1) + endif + set color to (__guicolor(::ColorSpec, 3)) + SetPos(::Row, ::Col) + ?? Left(cOldStyle, 1) + SetPos(::Row, ::Col + 2) + ?? right(cOldStyle, 1) + + if ( !Empty(cCaption := ::Caption) ) + if ( ( nPos := At("&", cCaption) ) == 0 ) + elseif ( nPos == Len(cCaption) ) + nPos := 0 + else + cCaption := stuff(cCaption, nPos, 1, "") + endif + SetPos(::CapRow, ::CapCol) + ?? cCaption + if ( nPos != 0 ) + set color to (__guicolor(::ColorSpec, 4)) + SetPos(::CapRow, ::CapCol + nPos - 1) + ?? SubStr(cCaption, nPos, 1) + endif + endif + dispend() + + set color to (cColor) + SetPos(nCurRow, nCurCol) + RETURN Self + + + +function __GUICOLOR( cPair, nPos ) + + local ccolor := cPair, nPosition, nCommaPos + for nPosition := 2 to nPos + nCommaPos := At(",", ccolor) + if ( nCommaPos == 0 ) + ccolor := "" + exit + endif + ccolor := SubStr(ccolor, nCommaPos + 1) + next + nCommaPos := At(",", ccolor) + if ( nCommaPos > 0 ) + ccolor := SubStr(ccolor, 1, nCommaPos - 1) + endif + return ccolor +function _CHECKBOX_( Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7) + + local Local1, Local2, Local3, Local4 + oCheck := checkbox(Row(), Col(), Arg2) + if ( !( ISNIL( oCheck ) ) ) + oCheck:select(Arg1) + oCheck:caption :=Arg2 + oCheck:colorspec :=Arg4 + oCheck:message:=Arg3 + if arg7 !=NIL + oCheck:style:=Arg7 + endif + oCheck:fblock:=Arg5 + oCheck:sblock:=Arg6 + + endif + return oCheck + +function IsDefColor() + Return (SETCOLOR() != "W/N,N/W,N/N,N/N,N/W") + +#endif diff --git a/harbour/source/rtl/getsys.prg b/harbour/source/rtl/getsys.prg index f5c7886116..b5d08d2e97 100644 --- a/harbour/source/rtl/getsys.prg +++ b/harbour/source/rtl/getsys.prg @@ -50,11 +50,32 @@ * */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2001 Luiz Rafael Culik + * Support for Ca-Clipper 5.3 Getsystem + * + * See doc/license.txt for licensing terms. + * + */ + #include "common.ch" - +#include "hbsetup.ch" +#ifndef HB_COMPAT_C53 FUNCTION ReadModal( GetList, nPos ) +#else +FUNCTION ReadModal( GetList, nPos, nMsgRow, nMsgLeft, nMsgRight, cMsgColor ) +#endif LOCAL oGetList - +#ifdef HB_COMPAT_C53 + Local lMsgFlag + Local cSaveColor + Local cOldMsg + Local lColorFlag + Local oGet +#endif IF Empty( GetList ) SetPos( MaxRow() - 1, 0 ) RETURN .F. @@ -69,14 +90,52 @@ FUNCTION ReadModal( GetList, nPos ) IF ! ( ISNUMBER( nPos ) .AND. nPos > 0 ) oGetList:nPos := oGetList:Settle( 0 ) ENDIF +#ifdef HB_COMPAT_C53 + if ( ! ValType( nMsgRow ) == "N" ) + lMsgFlag := .f. + elseif ( ! ValType( nMsgLeft ) == "N" ) + lMsgFlag := .f. + + elseif ( ! ValType( nMsgRight ) == "N" ) + lMsgFlag := .f. + + else + lMsgFlag := .t. + cOldMsg := SaveScreen( nMsgRow, nMsgLeft, nMsgRow, nMsgRight ) + lColorFlag := ( ValType( cMsgColor ) == "C" ) + + endif + + if ( lMsgFlag ) + oGet := oGetList:aGetList[ oGetList:nPos ] + if ( lColorFlag ) + cSaveColor := SetColor( cMsgColor ) + endif + + if ( ValType( oGet:Control ) == "O" ) + @ nMsgRow, nMsgLeft ; + say PadC( oGet:Control:Message, nMsgRight - nMsgLeft + 1 ) + else + @ nMsgRow, nMsgLeft ; + say PadC( oGet:Message, nMsgRight - nMsgLeft + 1 ) + endif + + if ( lColorFlag ) + SetColor( cSaveColor ) + endif + Endif +#endif DO WHILE oGetList:nPos != 0 oGetList:oGet := oGetList:aGetList[ oGetList:nPos ] oGetList:PostActiveGet() - IF ISBLOCK( oGetList:oGet:Reader ) + #ifndef HB_COMPAT_C53 Eval( oGetList:oGet:Reader, oGetList:oGet ) + #Else + Eval( oGetList:oGet:Reader, oGetList:oGet ,Ogetlist) + #endif ELSE oGetList:Reader() ENDIF @@ -84,17 +143,21 @@ FUNCTION ReadModal( GetList, nPos ) oGetList:nPos := oGetList:Settle() ENDDO - + #ifdef HB_COMPAT_C53 + if ( lMsgFlag ) + RestScreen( nMsgRow, nMsgLeft, nMsgRow, nMsgRight, cOldMsg ) + endif +#endif SetPos( MaxRow() - 1, 0 ) RETURN oGetList:lUpdated PROCEDURE GetReader( oGet ) - oGet:Reader() RETURN + FUNCTION GetActive( oGet ) LOCAL oGetList := __GetListActive() @@ -273,4 +336,47 @@ FUNCTION RangeCheck( oGet, xDummy, xLow, xHigh ) ENDIF RETURN .F. +#ifdef HB_COMPAT_C53 +PROCEDURE GUIReader( oGet ,oGetlist,a,b) + + oGetlist:GuiReader(oGet,oGetList,a,b) +return +PROCEDURE GuiApplyKey(oGet,nKey) + LOCAL oGetList := __GetListActive() + + IF oGetList != NIL + oGetList:oGet := oGet + oGetList:GUIApplyKey(oGet, nKey ) + ENDIF + + RETURN + +FUNCTION GuiGetPreValidate( oGet ,oGui) + LOCAL oGetList := __GetListActive() + + IF oGetList != NIL + IF oGet != NIL + oGetList:oGet := oGet + ENDIF + + RETURN oGetList:GetPreValidate() + ENDIF + + RETURN .F. + +FUNCTION GuiGetPostValidate( oGet,oGui ) + LOCAL oGetList := __GetListActive() + + IF oGetList != NIL + IF oGet != NIL + oGetList:oGet := oGet + ENDIF + + RETURN oGetList:GuiGetPostValidate(oGui) + ENDIF + + RETURN .F. + + +#endif diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index 662a4e2641..c0aa026f49 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -98,6 +98,10 @@ CLASS Get DATA SubScript DATA Type DATA TypeOut + #ifdef HB_COMPAT_C53 + DATA Control + DATA Message + #endif METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) diff --git a/harbour/source/rtl/tgetlist.prg b/harbour/source/rtl/tgetlist.prg index af9a9eedc0..91f04e74c2 100644 --- a/harbour/source/rtl/tgetlist.prg +++ b/harbour/source/rtl/tgetlist.prg @@ -50,6 +50,18 @@ * */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2001 Luiz Rafael Culik + * Support for Ca-Clipper 5.3 Getsystem + * + * See doc/license.txt for licensing terms. + * + */ + + #include "hbclass.ch" #include "common.ch" #include "getexit.ch" @@ -99,7 +111,12 @@ CLASS TGetList METHOD ReadExit( lNew ) INLINE Set( _SET_EXIT, lNew ) METHOD SetFocus() METHOD Updated() INLINE ::lUpdated - + #ifdef HB_COMPAT_C53 + METHOD GUIReader(oget,getsys,a,b) + METHOD GUIApplyKey( oGUI, nKey ) + METHOD GuiPreValidate(oGui) + METHOD GuiPostValidate(oGui) + #endif ENDCLASS METHOD New( GetList ) CLASS TGetList @@ -124,7 +141,6 @@ METHOD SetFocus() CLASS TGetList ::aGetList[ ::nPos ]:SetFocus() return Self - METHOD Reader() CLASS TGetList local oGet := ::oGet @@ -541,3 +557,255 @@ METHOD ReadUpdated( lUpdated ) CLASS TGetList endif return lSavUpdated + +#ifdef HB_COMPAT_C53 +METHOD GuiReader(oget,getsys,a,b) CLASS TGetList +//Local oGet := ::oGet + Local oGui + IF ( ! ::GUIPreValidate( oGet , oGet:Control ) ) + elseif ( ValType( oGet:Control ) == "O" ) + + // Activate the GET for reading + oGUI := oGet:Control + oGUI:Select( oGet:VarGet() ) + oGUI:setFocus() + + + WHILE ( oGet:exitState == GE_NOEXIT .AND. !::lKillRead ) + + // Check for initial typeout (no editable positions) + IF ( oGui:typeOut ) + oGet:exitState := GE_ENTER + ENDIF + + // Apply keystrokes until exit + WHILE ( oGet:exitState == GE_NOEXIT .AND. !::lKillRead ) + ::GUIApplyKey( oGUI,inkey(0)) + ENDDO + + // Disallow exit if the VALID condition is not satisfied + + IF ( !::GUIPostValidate( oGet, oGUI ) ) + oGet:exitState := GE_NOEXIT + ENDIF + ENDDO + + // De-activate the GET + oGet:VarPut( oGUI:Buffer ) + oGUI:killFocus() + + if ( ! oGUI:ClassName() == "LISTBOX" ) + elseif ( ! oGUI:DropDown ) + elseif ( oGUI:IsOpen ) + oGUI:Close() + endif + + ENDIF + + RETURN Self + +METHOD GUIApplyKey( oGUI, nKey ) CLASS TGetList + Local oGet:= ::oGet + LOCAL cKey + LOCAL bKeyBlock + local TheClass + local nHotItem + local lClose + + // Check for SET KEY first + IF !( ( bKeyBlock := setkey( nKey ) ) == NIL ) + ::GetDoSetKey( bKeyBlock, oGet ) + + ENDIF + + + if ( nKey == 0 ) + elseif ( ( TheClass := oGUI:ClassName() ) == "RADIOGROUP" ) + if ( nKey == K_UP ) + oGUI:PrevItem() + nKey := 0 + + elseif ( nKey == K_DOWN ) + oGUI:NextItem() + nKey := 0 + + elseif ( ( nHotItem := oGUI:GetAccel( nKey ) ) != 0 ) + oGUI:Select( nHotItem ) + + endif + + elseif ( TheClass == "CHECKBOX" ) + if ( nKey == K_SPACE ) + oGUI:Select() + + endif + + elseif ( TheClass == "PUSHBUTTON" ) + if ( nKey == K_SPACE ) + oGUI:Select( K_SPACE ) + + elseif ( nKey == K_ENTER ) + oGUI:Select() + nKey := 0 + + endif + + elseif ( TheClass == "LISTBOX" ) + if ( nKey == K_UP ) + oGUI:PrevItem() + nKey := 0 + + elseif ( nKey == K_DOWN ) + oGUI:NextItem() + nKey := 0 + + elseif ( nKey == K_SPACE ) + if ( ! oGUI:DropDown ) + elseif ( ! oGUI:IsOpen ) + oGUI:Open() + nKey := 0 + endif + + + endif + + 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: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 + + // Both ^W and ^End go to the last GET + CASE ( nKey == K_CTRL_END ) + oGet:exitState := GE_BOTTOM + +#else + + // Both ^W and ^End terminate the READ (the default) + CASE ( nKey == K_CTRL_W ) + oGet:exitState := GE_WRITE + +#endif + + + if ( ! lClose ) + elseif ( ! TheClass == "LISTBOX" ) + elseif ( ! oGUI:DropDown ) + elseif ( oGUI:IsOpen ) + oGUI:Close() + oGUI:Display() + endif + + ENDCASE + + RETURN Self + + + +METHOD GUIPostValidate( oGUI ) CLASS TGetList + Local oGet := ::oGet + LOCAL lSavUpdated + LOCAL lValid := .T. + LOCAL uOldData, uNewData + + + IF ( oGet:exitState == GE_ESCAPE ) + RETURN ( .T. ) // NOTE + ENDIF + + + // If editing occurred, assign the new value to the variable + IF ( ! ( uOldData == uNewData ) ) + oGet:VarPut( uNewData ) + ::lUpdated := .T. + ENDIF + + // Check VALID condition if specified + IF !( oGet:postBlock == NIL ) + + lSavUpdated := ::lUpdated + + lValid := EVAL( oGet:postBlock, oGet ) + + // Reset S'87 compatibility cursor position + SETPOS( oGet:row, oGet:col ) + + ::ShowScoreBoard() + IF ( ! ( oGUI:ClassName == "TBROWSE" ) ) + oGUI:Select( oGet:VarGet() ) + ENDIF + + ::lUpdated := lSavUpdated + + IF ( ::lKillRead ) + oGet:exitState := GE_ESCAPE // Provokes ReadModal() exit + lValid := .T. + + ENDIF + ENDIF + + RETURN ( lValid ) + +METHOD GUIPreValidate( oGUI ) CLASS TGetList + Local oGet := ::oGet + LOCAL lSavUpdated + LOCAL lWhen := .T. + + IF !( oGet:preBlock == NIL ) + lSavUpdated := ::lUpdated + + lWhen := EVAL( oGet:preBlock, oGet ) + + + ::ShowScoreBoard() + + ::lUpdated := lSavUpdated + ENDIF + + IF (::lKillRead) + + lWhen := .F. + oGet:exitState := GE_ESCAPE + + ELSEIF ( !lWhen ) + + oGet:exitState := GE_WHEN + + ELSE + + oGet:exitState := GE_NOEXIT + + ENDIF + + RETURN (lWhen) + +#endif diff --git a/harbour/tests/tstchbx.prg b/harbour/tests/tstchbx.prg new file mode 100644 index 0000000000..39268fd5ff --- /dev/null +++ b/harbour/tests/tstchbx.prg @@ -0,0 +1,43 @@ +/* + * $Id$ + */ + +#ifdef __HARBOUR__ +#command @ , GET ; + CHECKBOX ; + [VALID ] ; + [WHEN ] ; + [CAPTION ] ; + [MESSAGE ] ; + [COLOR ] ; + [FOCUS ] ; + [STATE ] ; + [STYLE