fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

See changelog 2001-07-20 20:00 GMT -3

Browse Source
This commit is contained in:
Luiz Rafael Culik
2001-07-20 22:45:46 +00:00
parent b42709f955
commit 1867ce0fa5
14 changed files with 712 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
harbour/ChangeLog
View File

@@ -1,3 +1,24 @@
2001-07-20 20:00 GMT -3 Luiz Rafael Culik <culik@sl.conex.net>
+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 <ron@profit-master.com>
* include/hbexpra.c
% Wrapped hb_compExprSetGetBlock() unneeded with simplex build, with #ifndef SIMPLEX

18
harbour/contrib/libct/token1.c
View File

@@ -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$
*/

3
harbour/contrib/libct/wordrepl.c
View File

@@ -116,8 +116,7 @@
* $FILES$
* Source is wordrepl.c, library is ct3.
* $SEEALSO$
* CHARREPL() RANGEREPL() POSREPL()
* CSETREF() CSETATMUPA()
* CHARREPL(),RANGEREPL(),POSREPL(),CSETREF(),CSETATMUPA()
* $END$
*/

8
harbour/hb_slex.bc
View File

@@ -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) -+$@,,

1
harbour/hb_slex.vc
View File

@@ -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 \

11
harbour/makefile.bc
View File

@@ -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$@ $**
$(CC) $(CLIBFLAGS) -o$@ $**

1
harbour/makefile.vc
View File

@@ -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 \

1
harbour/source/rtl/Makefile
View File

@@ -118,6 +118,7 @@ PRG_SOURCES=\
browdb.prg \
browdbx.prg \
browse.prg \
checkbox.prg \
dbdelim.prg \
dbedit.prg \
dbsdf.prg \

223
harbour/source/rtl/checkbox.prg Normal file
View File

@@ -0,0 +1,223 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CHECKBOX class
*
* Copyright 2000 Luiz Rafael Culik <culik@sl.conex.net>
* 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

116
harbour/source/rtl/getsys.prg
View File

@@ -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

4
harbour/source/rtl/tget.prg
View File

@@ -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 )

272
harbour/source/rtl/tgetlist.prg
View File

@@ -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

43
harbour/tests/tstchbx.prg Normal file
View File

@@ -0,0 +1,43 @@
/*
* $Id$
*/
#ifdef __HARBOUR__
#command @ <row>, <col> GET <var> ;
CHECKBOX ;
[VALID <valid>] ;
[WHEN <when>] ;
[CAPTION <caption>] ;
[MESSAGE <message>] ;
[COLOR <color>] ;
[FOCUS <fblock>] ;
[STATE <sblock>] ;
[STYLE <style>] ;
[SEND <msg>] ;
[GUISEND <guimsg>] ;
;
=> SetPos( <row>, <col> ) ;
; AAdd( GetList, ;
_GET_( <var>, <(var)>, NIL, <{valid}>, <{when}> ) ) ;
; ATail(GetList):Control := _CheckBox_( <var>, <caption>, ;
<message>, <color>, <{fblock}>, <{sblock}>, ;
<style> ) ;
; ATail(GetList):reader := { | a, b, c, d | ;
GuiReader( a, b, c, d ) } ;
[; ATail(GetList):<msg>] ;
[; ATail(GetList):Control:<guimsg>] ;
; ATail(GetList):Control:Display()
#endif
function Main
Local lx :=.f.
local ly :=.f.
cls
Setcolor('w/b+,w/b,w+/b,w/b+,w/b+,w/b+')
@ 2,3 Say "Married"
@ 2,12 Get lx CHECKBOX color 'w/b+,w/b,w+/r,w/g+'
@ 3,3 Say "Single"
@ 3,12 Get ly CHECKBOX color 'w/b+,w/b,w+/r,w/g+'
read
? "Is the Person Married",if(lx," Yes ", " No ")
? "Is the Person Single",if(ly," Yes ", " No ")
return Nil

22
harbour/utils/hbmake/hbmake.prg
View File

@@ -6,7 +6,7 @@
* Harbour Project source code:
* hbmake.Prg Harbour make utility main file
*
* Copyright 2000 Luiz Rafael Culik <culik@sl.conex.net>
* Copyright 2000,2001 Luiz Rafael Culik <culik@sl.conex.net>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
@@ -128,14 +128,15 @@ allparam:=strtran(allparam,"-v","-V")
allparam:=strtran(allparam,"-f","-F")
If Pcount() == 0
?? "Harbour Make Utility"
? "Copyright 1999-2000, http://www.harbour-project.org"
? "Copyright 2000,2001 Luiz Rafael Culik <culik@sl.conex.net>"
? ""
? "Syntax: hbmake cFile [options]"
? ""
? "Options: /e[l] Create an New Makefile,If /el is"
? " used it, creates an new make file to build an library"
? " /D Define an macro"
? " /p Print all command and depencies"
? "Options: /e[l] Create a new Makefile. If /el is"
? " used it creates a new make file to build a library"
? " /D Define a macro"
? " /p Print all commands and depencies"
if at("OS/2",cOs)>0
? " /b Use BCC as C compiler"
? " /g+ Use GCC as C compiler"
@@ -144,11 +145,12 @@ else
? " /g Use GCC as C compiler"
endif
? " /v Use MSVC as C compiler"
? " /f Force Recompiltion of all files"
? " /i Ignore errors returned by Commamnd"
? " /f Force recompiltion of all files"
? " /i Ignore errors returned by commamnd"
? " Note: /p and /D can be used together"
? " Options with + are the default Value"
? " -D switch can accept multiple macros in the same line"
? " Options with + are the default values"
? " -D switch can accept multiple macros on the same line"
? " or use one macro per -D switch"
Return NIL
Endif