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

See changelog 2002-03-18 12:16 UTC-0300

Browse Source 
* source/rtl/listbox.org
    source/rtl/radiobtn.prg
    source/rtl/radiogpr.prg
    source/rtl/checkbox.prg
    source/rtl/tget.prg
    source/rtl/pushbtn.prg
    source/rtl/tbrowse.prg
    source/rtl/getsys.prg
    source/rtl/tgetsys.prg
    * Added the missing Clip53 Methods and Functions
    % minor fix to Clip53 classes
This commit is contained in:
Luiz Rafael Culik
2002-03-18 15:23:59 +00:00
parent 39b01b9239
commit 297744b44e
8 changed files with 575 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
harbour/source/rtl/checkbox.prg
View File

@@ -77,7 +77,7 @@ METHOD SetFocus()
MESSAGE Select() METHOD _Select()
METHOD KillFocus()
METHOD DisPlay()
METHOD HitTest(nRow,nCol)
endclass
METHOD New(nRow,nCol,cCaption)
@@ -145,6 +145,25 @@ Method KillFocus() CLASS HBCHECKBOX
endif
RETURN Self
method HITTESt( Arg1, Arg2 ) CLASS HBCHECKBOX
local Local1, Local2
if ( Arg1 != ::Row )
elseif ( Arg2 < ::Col )
elseif ( Arg2 < ::Col + 3 )
return -2049
endif
Local2 := Len(::Caption)
if ( ( Local1 := At("&", ::Caption) ) == 0 )
elseif ( Local1 < Local2 )
Local2--
endif
if ( Arg1 != ::Caprow )
elseif ( Arg2 < ::CapCol )
elseif ( Arg2 < ::CapCol + Local2 )
return -1025
endif
return 0
Method Display() CLASS HBCHECKBOX
@@ -223,6 +242,7 @@ function IsDefColor()
local cColor:=SETCOLOR()
Return ( ccolor== "W/N,N/W,N/N,N/N,N/W")
function Checkbox(nr,ncol,cCaption)
default cCaption to ''
return HBCHECKBOX():new(nr, nCol, cCaption)
#endif

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

@@ -354,6 +354,19 @@ PROCEDURE GUIReader( oGet ,oGetlist,a,b)
oGetlist:GuiReader(oGet,oGetList,a,b)
RETURN
PROCEDURE TBReader( oGet, oGetList, aMsg )
oGetlist:TBReader(oGet,oGetList,aMsg)
return
PROCEDURE TBApplyKey( oGet, oTB, GetList, nKey, aMsg )
LOCAL oGetList := __GetListActive()
IF oGetList != NIL
oGetList:oGet := oGet
oGetList:Tbapplykey(oGet, oTB, GetList, nKey, aMsg)
endif
return
PROCEDURE GuiApplyKey(oGet,nKey)
LOCAL oGetList := __GetListActive()
@@ -391,4 +404,22 @@ FUNCTION GuiGetPostValidate( oGet,oGui )
RETURN .F.
FUNCTION HitTest( GetList, MouseRow, MouseCol, aMsg ) // Removed STATIC
local n
LOCAL oGetList := __GetListActive()
n:= oGetlist:Hittest( GetList, MouseRow, MouseCol, aMsg ) // Removed STATIC
return n
/***
*
* Accelerator( <GetList>, <nKey>, <aMsg> ) --> 0
*
* Identify the Accelerator key
*
***/
FUNCTION Accelerator( GetList, nKey, aMsg ) // Removed STATIC
return Getlist:Accelerator( GetList, nKey, aMsg ) // Removed STATIC
#endif

1
harbour/source/rtl/listbox.prg
View File

@@ -988,6 +988,7 @@ Function _LISTBOX_( Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, ;
Default arg5 To 1
Default arg12 To .f.
Default arg13 To .f.
default arg7 to ''
oScroll := Listbox( Arg1, Arg2, Arg3, Arg4, Arg12 )
If ( !( ISNIL( oScroll ) ) )
If ( Ischaracter( Arg7 ) )

1
harbour/source/rtl/pushbtn.prg
View File

@@ -286,6 +286,7 @@ return Nil
function _PUSHBUTT_( cCaption, cMessage, cColor, bFBlock, bSBlock, cStyle)
local oPushButton
default cCaption to ""
oPushButton := pushbutton(Row(), Col(), cCaption)
if ( !( ISNIL( oPushButton ) ) )
oPushButton:caption := if(cCaption !=Nil,cCaption,)

3
harbour/source/rtl/radiogrp.prg
View File

@@ -83,7 +83,7 @@ CLASS HBRadioGroup
DATA CapRow
DATA Caption init ""
DATA Caption
DATA Cargo init Nil
@@ -466,6 +466,7 @@ function _RADIOGRP_( nTop, nLeft, nBottom, nRight, xValue, aItems, cCaption, cMe
cColor, bFblock )
local oRadioGroup, nPos, nLen
default ccaption to ""
oRadioGroup := radiogroup(nTop, nLeft, nBottom, nRight)
if ( !( ISNIL( oRadioGroup ) ) )
oRadioGroup:caption:= if(cCaption!=NIL,cCaption,)

85
harbour/source/rtl/tbrowse.prg
View File

@@ -82,7 +82,7 @@
#include "color.ch"
#include "inkey.ch"
#include "setcurs.ch"
#include "button.ch"
CLASS TBrowse
DATA aColumns // Array to hold all browse columns
@@ -110,6 +110,7 @@ CLASS TBrowse
#ifdef HB_COMPAT_C53
DATA aKeys
DATA mColpos,mrowPos,message
#endif
ACCESS freeze INLINE ::nFrozenCols // Number of columns to freeze/frozen
@@ -155,6 +156,7 @@ CLASS TBrowse
METHOD ApplyKey(nKey)
METHOD InitKeys(Self)
METHOD TApplyKey(nKey, o)
METHOD HitTest(nMouseRow,nMouseCol)
#endif
PROTECTED: /* P R O T E C T E D */
@@ -199,7 +201,10 @@ CLASS TBrowse
DATA nFrozenCols // Number of frozen columns on left side of TBrowse
DATA nColumns // Number of columns added to TBrowse
DATA lNeverDisplayed // .T. if TBrowse has never been stabilize()d
#ifdef HB_COMPAT_C53
DATA rect
DATA aVisibleCols
#endif
ENDCLASS
@@ -247,7 +252,14 @@ METHOD New(nTop, nLeft, nBottom, nRight) CLASS TBrowse
::nLeft := nLeft
::nBottom := nBottom
::nRight := nRight
#ifdef HB_COMPAT_C53
::mColPos := 0
::mRowPos := 0
::rect:={nTop,nLeft,nBottom,nRight}
::aVisibleCols:={}
::message:=''
#endif
return Self
@@ -271,6 +283,7 @@ return Self
METHOD Configure(nMode) CLASS TBrowse
local n, nHeight
local nLeft,nRight
::lHeaders := .F.
::lFooters := .F.
@@ -335,7 +348,14 @@ METHOD Configure(nMode) CLASS TBrowse
if ::freeze > 0
::SetFrozenCols(::freeze)
endif
#ifdef HB_COMPAT_C53
nleft:=::nLeft
nRight:=::nRight
::rect:={::ntop+::nHeaderHeight,::nleft,::nbottom-::nHeaderHeight,::nright}
for n:= nleft to nright
aadd(::aVisibleCols,n)
next
#endif
return Self
@@ -1303,7 +1323,8 @@ METHOD InitKeys(o) CLASS TBROWSE
{K_CTRL_RIGHT,{|Ob,nKey| Ob:PanRight(),0}},;
{K_RIGHT,{|Ob,nKey| Ob:Right(),0}},;
{K_UP,{|Ob,nKey| Ob:Up(),0}},;
{K_ESC,{|Ob,nKey| -1 }}}
{K_ESC,{|Ob,nKey| -1 }},;
{K_LBUTTONDOWN,{|Ob,nKey| tbmouse(ob,mrow(),mcol())}}}
return o
@@ -1338,7 +1359,7 @@ return bReturn
METHOD TApplyKey( nKey, oBrowse ) CLASS tBrowse
local bBlock := oBrowse:setkey(nKey), nReturn
local bBlock := oBrowse:setkey(nKey), nReturn:=0
default bBlock to oBrowse:setkey(0)
@@ -1462,3 +1483,57 @@ function TBrowseNew(nTop, nLeft, nBottom, nRight)
return TBrowse():New(nTop, nLeft, nBottom, nRight)
#ifdef HB_COMPAT_C53
function TBMOUSE( oBrowse, nMouseRow, nMouseCol )
local Local1
if ( oBrowse:hittest(nMouseRow, nMouseCol) == -5121 )
tracelog('mouse row ',oBrowse:mrowpos)
tracelog('mouse col ',oBrowse:mcolpos)
Local1 := oBrowse:mrowpos - oBrowse:rowpos
tracelog('local1 ',local1)
do while ( Local1 < 0 )
Local1++
oBrowse:up()
enddo
do while ( Local1 > 0 )
Local1--
oBrowse:down()
enddo
Local1 := oBrowse:mcolpos - oBrowse:colpos
do while ( Local1 < 0 )
Local1++
oBrowse:left()
enddo
do while ( Local1 > 0 )
Local1--
oBrowse:right()
enddo
return 0
endif
return 1
Method hitTest(mrow,mcol) CLASS TBROWSE
local i
tracelog('mrow',mrow)
tracelog('mcol',mrow)
::mRowPos := ::rowPos
::mColPos := ::colPos
tracelog(::mrowPos)
if mRow< ::rect[1] .or. mRow > ::rect[3]
return HTNOWHERE
endif
if mCol < ::rect[2] .or. mCol > ::rect[4]
return HTNOWHERE
endif
::mRowPos := mRow - ::rect[1]+1
for i = 1 to len(::aVisibleCols)
if ::aVisibleCols[i] > mcol
exit
endif
next
::mColpos := ::aVisibleCols[i]
return HTCELL
#endif

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

@@ -58,7 +58,7 @@
#include "setcurs.ch"
#include "getexit.ch"
#include "inkey.ch"
#include "button.ch"
/* TODO: :posInBuffer( <nRow>, <nCol> ) --> nPos
Determines a position within the edit buffer based on screen
coordinates.
@@ -110,7 +110,7 @@ CLASS Get
#ifdef HB_COMPAT_XPP
MESSAGE _Assign METHOD Assign()
#endif
METHOD HitTest(mrow,mcol)
METHOD Block( bBlock ) SETGET // Replace to DATA Block
METHOD ColorSpec( cColorSpec ) SETGET // Replace to DATA ColorSpec
METHOD Picture( cPicture ) SETGET // Replace to DATA Picture
@@ -320,7 +320,7 @@ METHOD Display( lForced ) CLASS Get
endif
endif
if lForced .or. ( ::nDispPos != ::nOldPos )
if ::buffer != NIL .and. ( lForced .or. ( ::nDispPos != ::nOldPos ) )
DispOutAt( ::Row, ::Col,;
Substr( ::buffer, ::nDispPos, ::nDispLen ), ;
hb_ColorIndex( ::ColorSpec, iif( ::HasFocus, GET_CLR_ENHANCED, GET_CLR_UNSELECTED ) ) )
@@ -394,15 +394,18 @@ return Self
METHOD SetFocus() CLASS Get
local lWasNil := ::buffer == NIL
::hasfocus := .t.
::rejected := .f.
::typeout := .f.
::Original := ::VarGet()
::type := ValType( ::Original )
::buffer := ::PutMask( ::VarGet(), .f. )
::changed := .f.
::clear := ( "K" $ ::cPicFunc .or. ::type == "N")
::nMaxLen := Len( ::buffer )
::nMaxLen := IIF( ::buffer == NIL, 0, Len( ::buffer ) )
::pos := 1
::lEdit := .f.
@@ -420,7 +423,15 @@ METHOD SetFocus() CLASS Get
::BadDate := .f.
endif
::Display()
IF lWasNil .and. ::buffer != NIL
IF ::nDispLen == 0
::nDispLen := ::nMaxLen
ENDIF
::Display( .T. )
ELSE
::Display()
ENDIF
return Self
@@ -625,7 +636,7 @@ METHOD Insert( cChar ) CLASS Get
else
::buffer := Left( Substr( ::buffer, 1, ::Pos-1 ) + cChar + Substr( ::buffer, ::Pos ), ::nMaxLen )
endif
::Changed := !( ::unTransform() == ::Original )
::Assign()
::Right( .f. )
@@ -939,8 +950,8 @@ METHOD PutMask( xValue, lEdit ) CLASS Get
DEFAULT xValue TO ::VarGet()
DEFAULT lEdit TO ::HasFocus
if xValue == NIL
return ""
if xValue == NIL .OR. ValType( xValue ) $ "AB"
return NIL
endif
cBuffer := Transform( xValue, AllTrim( ::cPicFunc + " " + ::cPicMask ) )
@@ -1190,18 +1201,13 @@ METHOD Picture( cPicture ) CLASS Get
if cPicture != NIL
::nDispLen := NIL
::cPicture := cPicture
::ParsePict( cPicture )
::buffer := ::PutMask( )
::nMaxLen := Len( ::buffer )
if ::nDispLen == NIL
::nDispLen := ::nMaxLen
endif
::nMaxLen := IIF( ::buffer == NIL, 0, Len( ::buffer ) )
::nDispLen := ::nMaxLen
endif
return ::cPicture
@@ -1231,3 +1237,12 @@ METHOD Block( bBlock ) CLASS Get
return ::bBlock
METHOD HitTest(mrow,mcol) CLASS GET
if ::row != mrow
return HTNOWHERE
endif
if mcol >= ::col .and. mrow <= ::col+::ndispLen
return HTCLIENT
endif
return HTNOWHERE

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

@@ -67,7 +67,7 @@
#include "getexit.ch"
#include "inkey.ch"
#include "setcurs.ch"
#include "button.ch"
#define SCORE_ROW 0
#define SCORE_COL 60
@@ -91,7 +91,8 @@ CLASS HBGetList
DATA cReadProcName, nReadProcLine
DATA cVarName
DATA lHasFocus
Data nHitcode
Data nNextGet
METHOD New( GetList )
METHOD Settle( nPos )
METHOD Reader()
@@ -112,10 +113,15 @@ CLASS HBGetList
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)
METHOD TBApplyKey( oGet, oTB, nKey)
method TBReader( oGet)
Method Accelerator( nKey ) // Removed STATIC
method HitTest( MouseRow, MouseCol, aMsg ) // Removed STATIC
#endif
ENDCLASS
@@ -132,6 +138,7 @@ METHOD New( GetList ) CLASS HBGetList
::nPos := 1
::oGet := iif( ISARRAY( GetList ) .AND. Len( GetList ) >= 1, GetList[ 1 ], NIL )
::lHasFocus := .F.
::nHitcode:=0
return Self
@@ -155,6 +162,10 @@ METHOD Reader() CLASS HBGetList
oGet:ExitState := GE_ENTER
endif
if oGet:buffer == NIL
oGet:ExitState := GE_ENTER
endif
while oGet:exitState == GE_NOEXIT
::GetApplyKey( Inkey( 0 ) )
end
@@ -172,11 +183,21 @@ return Self
METHOD GetApplyKey( nKey ) CLASS HBGetList
local cKey, bKeyBlock, oGet := ::oGet
LOCAL MouseRow, MouseColumn
LOCAL nButton
LOCAL nHotItem
if ! ( ( bKeyBlock := Setkey( nKey ) ) == NIL )
::GetDoSetKey( bKeyBlock )
return Self
endif
IF ( !( ::aGetList == NIL ) .AND. ;
( ( nHotItem := ::Accelerator( nKey ) ) != 0 ) )
oGet:ExitState := GE_SHORTCUT
oGet:NnEXTgET := nHotItem
oGet:nLastExitState := GE_SHORTCUT // Added.
ENDIF
do case
case nKey == K_UP
@@ -221,6 +242,50 @@ METHOD GetApplyKey( nKey ) CLASS HBGetList
Set( _SET_INSERT, ! Set( _SET_INSERT ) )
::ShowScoreboard()
CASE( ( nKey == K_LBUTTONDOWN ) .OR. ( nKey == K_LDBLCLK ) )
MouseRow := mROW()
MouseColumn := mCOL()
nButton := 0
IF ( nButton != 0 )
ELSEIF ( ( nButton := ;
oGet:HitTest( MouseRow, MouseColumn ) ) == HTCLIENT )
DO WHILE ( oGet:Col + oGet:Pos - 1 > MouseColumn )
oGet:Left()
// Handle editing buffer if first character is non-editable:
IF oGet:typeOut
// reset typeout:
oGet:Home()
EXIT
ENDIF
ENDDO
DO WHILE ( oGet:Col + oGet:Pos - 1 < MouseColumn )
oGet:Right()
// Handle editing buffer if last character is non-editable:
IF oGet:typeOut
// reset typeout:
oGet:End()
EXIT
ENDIF
ENDDO
ELSEIF !( nButton == HTNOWHERE )
ELSEIF ( !( ::aGetList == NIL ) .AND. ;
::HitTest( MouseRow, MouseColumn, ) != 0 ) // Changed.
oGet:exitstate := GE_MOUSEHIT
oget:nLastExitState := GE_MOUSEHIT // Added.
ELSE
oGet:exitstate := GE_NOEXIT
ENDIF
case nKey == K_UNDO
oGet:UnDo()
@@ -291,6 +356,7 @@ METHOD GetPreValidate() CLASS HBGetList
local lUpdated, lWhen := .t.
if oGet:PreBlock != NIL
oGet:type := ValType( oGet:VarGet() )
lUpdated := ::lUpdated
lWhen := Eval( oGet:PreBlock, oGet )
oGet:Display()
@@ -398,7 +464,14 @@ METHOD Settle( nPos ) CLASS HBGetList
::lBumpTop := .f.
::lBumpBot := .f.
else
nExitState := ::nLastExitState
IF ::nLastExitState != 0
nExitState := ::nLastExitState
ELSEIF ::nNextGet < ::nLastPos
nExitState := GE_UP
ELSE
nExitState := GE_DOWN
ENDIF
endif
do case
@@ -420,6 +493,12 @@ METHOD Settle( nPos ) CLASS HBGetList
case nExitState == GE_ENTER
nPos++
CASE( nExitState == GE_SHORTCUT )
RETURN ( ::nNextGet )
CASE( nExitState == GE_MOUSEHIT )
RETURN ( ::nNextGet )
endcase
if nPos == 0
@@ -592,8 +671,7 @@ METHOD GuiReader(oget,getsys,a,b) CLASS HBGetList
oGet:exitState := GE_NOEXIT
ENDIF
ENDDO
// De-activate the GET
// De-activate the GET
oGet:VarPut( oGUI:Buffer )
oGUI:killFocus()
@@ -614,13 +692,17 @@ METHOD GUIApplyKey( oGUI, nKey ) CLASS HBGetList
local TheClass
local nHotItem
local lClose
LOCAL MouseRow, MouseColumn,nButton
// Check for SET KEY first
IF !( ( bKeyBlock := setkey( nKey ) ) == NIL )
::GetDoSetKey( bKeyBlock, oGet )
ENDIF
IF ( ( nHotItem := ::Accelerator( nKey ) ) != 0 )
oGet:ExitState := GE_SHORTCUT
::nNextGet := nHotItem
endif
if ( nKey == 0 )
elseif ( ( TheClass := oGUI:ClassName() ) == "RADIOGROUP" )
@@ -637,6 +719,10 @@ METHOD GUIApplyKey( oGUI, nKey ) CLASS HBGetList
endif
IF VALTYPE( oGet:VarGet() ) == "N"
oGet:VarPut( oGui:Value )
ENDIF
elseif ( TheClass == "CHECKBOX" )
if ( nKey == K_SPACE )
oGUI:Select()
@@ -668,9 +754,15 @@ METHOD GUIApplyKey( oGUI, nKey ) CLASS HBGetList
oGUI:Open()
nKey := 0
endif
ELSEIF ( ( nButton := oGUI:FindText( CHR( nKey ), oGUI:Value + 1, ;
.F., .F. ) ) != 0 )
oGUI:Select( nButton )
endif
IF VALTYPE( oGet:VarGet() ) == "N"
oGet:VarPut( oGui:Value )
ENDIF
endif
@@ -718,6 +810,39 @@ METHOD GUIApplyKey( oGUI, nKey ) CLASS HBGetList
oGet:exitState := GE_WRITE
#endif
CASE( ( nKey == K_LBUTTONDOWN ) .OR. ( nKey == K_LDBLCLK ) )
MouseRow := mROW()
MouseColumn := mCOL()
nButton:=0
lClose := .T.
IF ( nButton != 0 )
ELSEIF ( ( nButton := ;
oGUI:HitTest( MouseRow, MouseColumn ) ) == HTNOWHERE )
// Changed test:
IF ( ::HitTest( MouseRow, MouseColumn ) != 0 )
oGet:exitstate := GE_MOUSEHIT
::nLastExitState := GE_MOUSEHIT // Added.
ELSE
oGet:exitstate := GE_NOEXIT
ENDIF
ELSEIF ( nButton >= HTCLIENT )
oGUI:Select( nButton )
ELSEIF ( nButton == HTDROPBUTTON )
IF ( !oGUI:IsOpen )
oGUI:Open()
lClose := .F.
ENDIF
ELSEIF ( ( nButton >= HTSCROLLFIRST ) .AND. ;
( nButton <= HTSCROLLLAST ) )
oGUI:Scroll( nButton )
lClose := .F.
ENDIF
if ( ! lClose )
elseif ( ! TheClass == "LISTBOX" )
@@ -730,6 +855,80 @@ METHOD GUIApplyKey( oGUI, nKey ) CLASS HBGetList
ENDCASE
RETURN Self
METHOD TBApplyKey( oGet, oTB, nKey, aMsg ) CLASS HBGETLIST
LOCAL cKey
LOCAL bKeyBlock
LOCAL MouseRow, MouseColumn
LOCAL nButton
LOCAL nHotItem
LOCAL lSetKey
// Check for SET KEY first
IF !( ( bKeyBlock := SETKEY( nKey ) ) == NIL )
IF ( lSetKey := ::GetDoSetKey( bKeyBlock, oGet ) )
RETURN self
ENDIF
ENDIF
IF ( ( nHotItem := ::Accelerator( nKey) ) != 0 )
oGet:ExitState := GE_SHORTCUT
ENDIF
DO CASE
CASE( nKey == K_TAB )
oGet:exitState := GE_DOWN
CASE( nKey == K_SH_TAB )
oGet:exitState := GE_UP
CASE( nKey == K_ENTER )
IF !oTb:Stable()
oTb:ForceStable()
endif
oGet:exitState := GE_ENTER
CASE( nKey == K_ESC )
IF ( SET( _SET_ESCAPE ) )
oGet:exitState := GE_ESCAPE
ENDIF
#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
CASE( ( nKey == K_LBUTTONDOWN ) .OR. ( nKey == K_LDBLCLK ) )
MouseRow := mROW()
MouseColumn := mCOL()
nButton:=0
IF ( nButton != 0 )
ELSEIF ( ( nButton := ;
oTB:HitTest( MouseRow, MouseColumn ) ) == HTNOWHERE )
// Changed test:
IF ( ::HitTest( MouseRow, MouseColumn, aMsg ) != 0 )
oGet:exitstate := GE_MOUSEHIT
ELSE
oGet:exitstate := GE_NOEXIT
ENDIF
ENDIF
ENDCASE
RETURN self
METHOD GUIPostValidate( oGUI ) CLASS HBGetList
@@ -808,5 +1007,209 @@ METHOD GUIPreValidate( oGUI ) CLASS HBGetList
ENDIF
RETURN (lWhen)
method TBReader( oGet,oGetsys, aMsg ) Class HBGETLIST
LOCAL oTB, nKey, lAutoLite, nCell, nSaveCursor, nProcessed
LOCAL nRow, nCol
// local oGui:=oGet:control
// Read the GET if the WHEN condition is satisfied
IF ( VALTYPE( oGet:control ) == "O" ) .AND. ; // Moved up 2 lines.
::nLastExitState == GE_SHORTCUT .OR. ; // Added.
::nLastExitState == GE_MOUSEHIT .OR. ; // Added.
::GetPreValidate( oGet, aMsg )
// ShowGetMsg( oGet, aMsg )
::nLastExitState := 0 // Added.
nSaveCursor := SetCursor( SC_NONE )
// Activate the GET for reading
oTB := oGet:Control
lAutoLite := oTB:Autolite
oTB:Autolite := .T.
oTB:Hilite()
IF oGet:exitState == GE_NOEXIT // Added.
IF ( ::nHitcode == HTCELL )
tracelog('hitcode ',::nHitcode )
// Replaces call to TBMouse( oTB, mROW(), mCOL() ):
oTB:RowPos := oTb:mRowPos
oTB:ColPos := oTb:mColPos
oTB:Invalidate()
ENDIF
ENDIF // Added.
::nHitcode := 0
WHILE ( oGet:exitState == GE_NOEXIT .AND. !::lKillRead )
// Apply keystrokes until exit
WHILE ( oGet:exitState == GE_NOEXIT .AND. !::lKillRead )
nKey := 0
WHILE ( !( oTB:Stabilize() ) .AND. ( nKey == 0 ) )
nKey := Inkey()
ENDDO
IF ( nKey == 0 )
nKey := Inkey(0)
ENDIF
nProcessed := oTB:ApplyKey( nKey )
IF ( nProcessed == TBR_EXIT )
oGet:exitState := GE_ESCAPE
EXIT
ELSEIF ( nProcessed == TBR_EXCEPTION )
::TBApplyKey( oGet, oTB, nKey, aMsg )
// nRow := ROW() // Commented out.
// nCol := COL() // Commented out.
// ShowGetMsg( oGet, aMsg )
// DevPos( nRow, nCol ) // Commented out.
ENDIF
ENDDO
// Disallow exit if the VALID condition is not satisfied
IF ::nLastExitState == GE_SHORTCUT // Added.
ELSEIF ::nLastExitState == GE_MOUSEHIT // Added.
ELSEIF ( !::GetPostValidate( oGet, aMsg ) ) // Changed.
// IF ( !::GUIPostValidate( oGet, oGUI, aMsg ) ) // Old test.
oGet:exitState := GE_NOEXIT
ENDIF
ENDDO
// De-activate the GET
oTB:Autolite := lAutoLite
oTB:DeHilite()
SetCursor( nSaveCursor )
ENDIF
RETURN self
METHOD Accelerator( nKey) CLASS HBGETLIST// Removed STATIC
LOCAL nGet, oGet, nHotPos, cKey, cCaption, nStart, nEnd
LOCAL nIteration, lGUI
IF ( ( nKey >= K_ALT_Q ) .AND. ( nKey <= K_ALT_P ) )
cKey := SUBSTR( "qwertyuiop", nKey - K_ALT_Q + 1, 1 )
ELSEIF ( ( nKey >= K_ALT_A ) .AND. ( nKey <= K_ALT_L ) )
cKey := SUBSTR( "asdfghjkl", nKey - K_ALT_A + 1, 1 )
ELSEIF ( ( nKey >= K_ALT_Z ) .AND. ( nKey <= K_ALT_M ) )
cKey := SUBSTR( "zxcvbnm", nKey - K_ALT_Z + 1, 1 )
ELSEIF ( ( nKey >= K_ALT_1 ) .AND. ( nKey <= K_ALT_0 ) )
cKey := SUBSTR( "1234567890", nKey - K_ALT_1 + 1, 1 )
ELSE
RETURN ( 0 )
ENDIF
nStart := ::nPos + 1
nEnd := LEN( ::aGetList )
FOR nIteration := 1 TO 2
FOR nGet := nStart TO nEnd
oGet := ::aGetList[ nGet ]
IF ( VALTYPE( oGet:Control ) == "O" .AND. ;
oGet:Control:ClassName() != "TBROWSE" )
cCaption := oGet:Control:Caption
ELSE
cCaption := oGet:Caption
ENDIF
IF ( ( nHotPos := AT( "&", cCaption ) ) == 0 )
ELSEIF ( nHotPos == LEN( cCaption ) )
ELSEIF ( LOWER( SUBSTR( cCaption, nHotPos + 1, 1 ) ) == cKey )
// Test the current GUI-GET or Get PostValidation:
lGUI := ( VALTYPE( ::aGetList[ ::nPos ]:Control ) == "O" )
IF lGUI .AND. !( ::GUIPostValidate( ::aGetList[ ::nPos ], ;
::aGetList[ ::nPos ]:Control, ) )
RETURN 0
ELSEIF !lGUI .AND. !( ::GetPostValidate( ::aGetList[ ::nPos ], ;
) )
RETURN 0
ENDIF
// Test the next GUI-GET or Get PreValidation:
lGUI := ( VALTYPE( oGet:Control ) == "O" )
IF lGUI .AND. !( ::GUIPreValidate( oGet, oGet:Control, ) )
// RETURN 0 // Commented out.
RETURN nGet // Changed.
ELSEIF !lGUI .AND. !( ::GetPreValidate( oGet, ) )
// RETURN 0 // Commented out.
RETURN nGet // Changed.
ENDIF
RETURN ( nGet )
ENDIF
NEXT
nStart := 1
nEnd := ::nPos - 1
NEXT
RETURN ( 0 )
method HitTest( MouseRow, MouseCol, aMsg ) CLASS HBGETLIST
LOCAL nCount, nTotal, lGUI
::nNextGet := 0
nTotal := LEN( ::aGetList )
FOR nCount := 1 TO nTotal
IF ( ( ::nHitCode := ;
::aGetList[ nCount ]:HitTest( MouseRow, MouseCol ) ) != HTNOWHERE )
::nNextGet := nCount
EXIT
ENDIF
NEXT
// DO WHILE !( ::nNextGet == 0 ) // Commented out.
IF !( ::nNextGet == 0 ) // Changed.
// Test the current GUI-GET or Get PostValidation:
lGUI := ( VALTYPE( ::aGetList[ ::nPos]:Control ) == "O" )
IF lGUI .AND. !( ::GUIPostValidate( ::aGetList[ ::nPos], ;
::aGetList[ ::nPos]:Control, aMsg ) )
::nNextGet := 0
// EXIT // Commented out.
RETURN 0 // Changed.
ELSEIF !lGUI .AND. !( ::GetPostValidate( ::aGetList[ ::nPos], ;
aMsg ) )
::nNextGet := 0
// EXIT // Commented out.
RETURN 0 // Changed.
ENDIF
// Test the next GUI-GET or Get PreValidation:
lGUI := ( VALTYPE( ::aGetList[ ::nNextGet ]:Control ) == "O" )
IF lGUI .AND. !( ::GUIPreValidate( ::aGetList[ ::nNextGet ], ;
::aGetList[ ::nNextGet ]:Control, aMsg ) )
::nNextGet := 0
// EXIT // Commented out.
RETURN ::nNextGet // Changed.
ELSEIF !lGUI .AND. !( ::GetPreValidate( ::aGetList[ ::nNextGet ], ;
aMsg ) )
::nNextGet := 0
// EXIT // Commented out.
RETURN ::nNextGet // Changed.
ENDIF
// EXIT // Commented out.
RETURN ::nNextGet // Changed.
// ENDDO // Commented out.
ENDIF // Changed.
// RETURN ( ::nNextGet != 0 ) // Commented out.
RETURN 0 // Changed.
#endif