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

see changelog 2001-02-01 22:10 GMT -3

Browse Source
This commit is contained in:
Luiz Rafael Culik
2001-02-02 00:20:00 +00:00
parent 4abe0d791f
commit fbcd651dd1
3 changed files with 732 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

324
harbour/source/debug/dbgtarr.prg Normal file
View File

@@ -0,0 +1,324 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* The Debugger Array Inspector
*
* Copyright 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
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "setcurs.ch"
#include "hbclass.ch"
#include "inkey.ch"
Class TDBGArray
data aWindows
data TheArray
data arrayname
data nCurWindow
Method new
method addWindows
method doget
method SetsKeyPressed
end class
method new(aArray,pArName) Class TDBGArray
::aWindows:={}
::arrayName:=parName
::TheArray:=aArray
::nCurWindow:=0
::addWindows(::TheArray)
Return Self
Method addWindows(aArray,nRow) Class TDBGArray
local oBrwSets,nSize:=Len(AArray)
local n:=1
Local owndsets
local nWidth
local oCol
if (nsize<maxrow()-2)
if nRow <> nil
owndsets:=TDbWindow():New( GetTopPos(nRow), 11, getBottomPos(nRow+nsize+1), maxcol()-5, ::arrayName+"[1.."+alltrim(str(nsize,4))+"]" ,"N/W" )
else
owndsets:=TDbWindow():New( 1, 11, 1+nsize, maxcol()-5, ::arrayName+"[1.."+alltrim(str(nsize,4))+"]" ,"N/W")
endif
else
owndsets:=TDbWindow():New( 1, 11, maxrow()-2, maxcol()-5, ::arrayName+"[1.."+alltrim(str(nsize,4))+"]" ,"N/W")
endif
::nCurWindow++
oWndSets:lFocused:=.t.
aadd(::aWindows,owndsets)
nWidth := oWndSets:nRight - oWndSets:nLeft - 1
oBrwSets:=TbrowseNew(owndsets:nTop+1, owndsets:nLeft+1, owndsets:nBottom-1, owndsets:nRight-1)
oBrwSets:ColorSpec := "N/W, R/W, N/bg"
oBrwSets:GoTopBlock := { || n := 1 }
oBrwSets:GoBottomBlock := { || n := Len( aArray ) }
oBrwSets:SkipBlock := { | nSkip, nPos | nPos := n,;
n := iif( nSkip > 0, Min( Len( aArray ), n + nSkip ),;
Max( 1, n + nSkip ) ), n - nPos }
oBrwSets:AddColumn( ocol:= TBColumnNew("", { || ::arrayName+"["+alltrim(str(n,4))+"]"} ) )
ocol:width:=len(::arrayName+"["+alltrim(str(len(aarray),4))+"]" )
ocol:ColorBlock := { || { iif( n == oBrwSets:Cargo, 2, 1 ), 2 } }
oBrwSets:Freeze:=1
oBrwSets:AddColumn( ocol:=TBColumnNew( "" ,{ || PadR( ValToStr( aArray[ n ] ), nWidth - 12 ) } ) )
oBrwSets:Cargo := 1 // Actual highligthed row
ocol:ColorBlock := { || { iif( n == oBrwSets:Cargo, 3, 1 ), 3 } }
oBrwsets:colpos:=2
::aWindows[::nCurWindow]:bPainted := { || oBrwSets:ForceStable(), myColors(oBrwsets,{1,2}) }
::aWindows[::nCurWindow]:bKeyPressed := { | nKey | ::SetsKeyPressed( nKey, oBrwSets, Len( aArray ),;
::aWindows[::nCurWindow],::arrayName ,Len(aArray),aArray) }
SetCursor( SC_NONE )
::aWindows[::nCurWindow]:ShowModal()
return self
method SetsKeyPressed( nKey, oBrwSets, nSets, oWnd ,cName,LenArr,aArray) Class TDBGArray
local nSet := oBrwSets:Cargo
local cTemp:=str(nSet,4)
local cOldname:= ::arrayName
Local nPos
do case
case nKey == K_UP
if oBrwSets:Cargo > 1
oBrwSets:Cargo--
SetsUp( oBrwSets )
endif
case nKey == K_DOWN
if oBrwSets:Cargo < nSets
oBrwSets:Cargo++
SetsDown( oBrwSets )
endif
case nKey == K_HOME
if oBrwSets:Cargo > 1
oBrwSets:Cargo := 1
oBrwSets:GoTop()
oBrwSets:RefreshAll()
oBrwSets:ForceStable()
endif
case nKey == K_END
if oBrwSets:Cargo < nSets
oBrwSets:Cargo := nSets
oBrwSets:GoBottom()
oBrwSets:RefreshAll()
oBrwSets:ForceStable()
endif
Case nKey ==13
if nSet==oBrwSets:Cargo
if valtype(aArray[nSet])=="A"
SetPos(ownd:nBottom,ownd:nLeft)
::aWindows[::nCurwindow]:lFocused:=.f.
::arrayname:= ::arrayname+"["+alltrim(cTemp)+"]"
::AddWindows(aArray[nSet],oBrwSets:RowPos+oBrwSets:nTop)
::arrayname:=coldname
adel(::aWindows,::nCurWindow)
asize(::awindows,len(::awindows)-1)
if ::nCurwindow==0
::ncurwindow:=1
else
::ncurwindow--
endif
elseif valtype(aArray[nSet])=="B"
Alert("Value cannot be edited")
else
oBrwSets:RefreshCurrent()
::doget(oBrwsets,aarray,nSet)
oBrwSets:RefreshCurrent()
oBrwSets:ForceStable()
endif
endif
endcase
if nSet != oBrwSets:Cargo
::aWindows[::nCurwindow]:SetCaption( cName + "["+AllTrim( Str( oBrwSets:Cargo ) ) +".."+ ;
Alltrim(str(LenArr))+ "]")
endif
myColors(oBrwsets,{1,2})
return self
static procedure SetsUp( oBrw )
local nRow := oBrw:RowPos
local nSetPos
if oBrw:RowPos == 1
nSetPos := oBrw:Cargo
oBrw:Cargo := 0
oBrw:Refreshall()
oBrw:ForceStable()
oBrw:Cargo := nSetPos
endif
oBrw:colpos:=1
oBrw:dehilite()
oBrw:colpos:=2
oBrw:Up()
oBrw:Refreshall()
if nRow != oBrw:Cargo
oBrw:aReDraw[ nRow ] := .f.
oBrw:Up()
endif
oBrw:ForceStable()
myColors(oBrw,{1,2})
return
static procedure SetsDown( oBrw )
local nRow := oBrw:RowPos
local nSetPos
if oBrw:RowPos == oBrw:RowCount
nSetPos := oBrw:Cargo
oBrw:Cargo := 0
oBrw:Refreshall()
oBrw:ForceStable()
oBrw:Cargo := nSetPos
endif
oBrw:colpos:=1
oBrw:dehilite()
oBrw:colpos:=2
oBrw:Down()
oBrw:Refreshall()
if nRow != oBrw:Cargo
oBrw:aReDraw[ nRow ] := .f.
oBrw:Down()
endif
oBrw:ForceStable()
myColors(oBrw,{1,2})
return
static function ValToStr( uVal )
local cType := ValType( uVal )
local cResult := "U"
do case
case uVal == nil
cResult := "NIL"
Case cType =="B"
cResult:= "{ || ... }"
case cType == "A"
cResult := "{ ... }"
case cType $ "CM"
cResult := '"' + uVal + '"'
case cType == "L"
cResult := iif( uVal, ".T.", ".F." )
case cType == "D"
cResult := DToC( uVal )
case cType == "N"
cResult := AllTrim( Str( uVal ) )
case cType == "O"
cResult := "Class " + uVal:ClassName() + " object"
endcase
return cResult
METHOD doGet(oBro,pItem,nSet) Class TDBGArray
LOCAL column, nKey
local getlist:={}
// save state
LOCAL lScoreSave := Set( _SET_SCOREBOARD, .f. )
LOCAL lExitSave := Set( _SET_EXIT, .t. )
LOCAL bInsSave := SetKey( K_INS )
// make sure browse is stable
obro:forcestable()
// if confirming new record, append blank
// set insert key to toggle insert mode and cursor
SetKey( K_INS, ;
{ || SetCursor( if(ReadInsert(!ReadInsert()), SC_NORMAL, SC_INSERT)) };
)
// initial cursor setting
SetCursor( IF( ReadInsert(), SC_INSERT, SC_NORMAL ) )
// get column object from browse
column := oBro:getColumn( oBro:colPos )
// create a corresponding GET
@ row(),col() get pItem[nSet]
// read it
ReadModal(getlist )
SetCursor( 0 )
Set( _SET_SCOREBOARD, lScoreSave )
Set( _SET_EXIT, lExitSave )
SetKey( K_INS, bInsSave )
// check exit key from get
nKey := LastKey()
IF nKey == K_UP .OR. nKey == K_DOWN .OR. nKey == K_PGUP .OR. nKey == K_PGDN
KEYBOARD CHR( nKey )
END
RETURN nil
static function myColors( oBrowse, aColColors )
local i
local nColPos := oBrowse:colpos
for i := 1 to len( aColColors )
oBrowse:colpos := aColColors[i]
oBrowse:hilite()
if oBrowse:colPos==1
oBrowse:dehilite()
endif
next
oBrowse:colpos := nColPos
return Nil
function __DbgArrays(aArray,cArrayName)
return TDBGArray():New(aArray,cArrayName)
Static function GetTopPos(nPos)
Local nReturn:=0
nReturn:=if((maxrow()-nPos)<5,Maxrow()-nPos,nPos)
return nReturn
Static function GetBottomPos(nPos)
Local nReturn:=0
nReturn :=if(nPos<maxrow()-2,nPos ,maxrow()-2)
return nReturn

359
harbour/source/debug/dbgtobj.prg Normal file
View File

@@ -0,0 +1,359 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* The Debugger Object Inspector
*
* Copyright 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
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "setcurs.ch"
#include "common.ch"
#include "hbclass.ch"
#include "inkey.ch"
#pragma -es0
Class TDBGobject
//export:
data aWindows
data Theobj
data objname
data nCurWindow
data pItems
Data ArrayReference
Data ArrayIndex
Data AllNames
Method new
method addWindows
method doget
method SetsKeyPressed
endclass
method new(aArray,pArName) class tdbgObject
Local nPos
local aTempvars:= __objGetValueList(aArray)
Local aTempMethods:= __objGetMethodList(aArray)
::pItems:={}
::AllNames:={}
for nPos :=1 to len(aTempvars)
aadd(::pItems,{aTempvars[nPos,1],aTempvars[nPos,2]})
aadd(::AllNames,aTempvars[nPos,1])
next
for nPos :=1 to len(aTempMethods)
if !empty(aTempMethods[nPos])
aadd(::pItems,{aTempMethods[nPos],"Method"})
aadd(::AllNames,aTempMethods[nPos])
endif
next
::aWindows:={}
::objname:=parName
::TheObj:=aArray
::nCurWindow:=0
::ArrayReference:={}
::ArrayIndex:=1
::addWindows(::pItems)
Return Self
Method addWindows(aArray,nRow) class tdbgObject
local oBrwSets,nSize:=Len(AArray)
//local n:=1
Local owndsets
local nWidth
local oCol
if (nsize<maxrow()-2)
if nRow <> nil
owndsets:=TDbWindow():New( nRow, 11, if(nRow+nsize+1<maxrow()-2,nRow+nsize+1,maxrow()-2), maxcol()-5, ::objname +" is of class:" +::TheObj:classname() ,"N/W" )
else
owndsets:=TDbWindow():New( 1, 11, 1+nsize, maxcol()-5, ::objname +" is of class:" +::TheObj:classname() ,"N/W")
endif
else
owndsets:=TDbWindow():New( 1, 11, maxrow()-2, maxcol()-5, ::objname +" is of class:" +::TheObj:classname() ,"N/W")
endif
::nCurWindow++
oWndSets:lFocused:=.t.
aadd(::aWindows,owndsets)
nWidth := oWndSets:nRight - oWndSets:nLeft - 1
oBrwSets:=TbrowseNew(owndsets:nTop+1, owndsets:nLeft+1, owndsets:nBottom-1, owndsets:nRight-1)
::ArrayReference:=aarray
oBrwSets:ColorSpec := "N/W, R/W, N/bg"
oBrwSets:GoTopBlock := { || ::Arrayindex := 1 }
oBrwSets:GoBottomBlock := { || ::arrayindex := Len( ::ArrayReference) }
oBrwSets:SkipBlock := { | nSkip, nPos | nPos := ::arrayindex,;
::arrayindex := iif( nSkip > 0, Min( ::arrayindex+nSkip, Len(::arrayreference)),;
Max( 1, ::arrayindex + nSkip ) ), ::arrayindex - nPos }
oBrwSets:AddColumn( ocol:= TBColumnNew("", { || ::ArrayReference[::arrayindex,1]} ))
// ocol:width:=maxelem(::AllNames)
ocol:ColorBlock := { || { iif( ::Arrayindex == oBrwSets:Cargo, 2, 1 ), 2 } }
oBrwSets:Freeze:=1
oBrwSets:AddColumn( ocol:=TBColumnNew( "" ,{ || PadR( ValToStr( ::ArrayReference[ ::arrayindex ,2] ), nWidth - 12 ) } ) )
oBrwSets:Cargo := 1 // Actual highligthed row
ocol:ColorBlock := { || { iif( ::Arrayindex == oBrwSets:Cargo, 3, 1 ), 3 } }
// ocol:width:=15
oBrwsets:colpos:=2
::aWindows[::nCurWindow]:bPainted := { || oBrwSets:ForceStable(), myColors(oBrwsets,{1,2}) }
::aWindows[::nCurWindow]:bKeyPressed := { | nKey | ::SetsKeyPressed( nKey, oBrwSets, Len( aArray ),;
::aWindows[::nCurWindow],::objname ,Len(::Arrayreference),::pitems) }
SetCursor( SC_NONE )
::aWindows[::nCurWindow]:ShowModal()
return self
method SetsKeyPressed( nKey, oBrwSets, nSets, oWnd ,cName,LenArr,aArray) class tdbgObject
local nSet := oBrwSets:Cargo
local cTemp:=str(nSet,4)
local cOldname:= ::objname
Local nPos
do case
case nKey == K_UP
if oBrwSets:Cargo > 1
oBrwSets:Cargo--
SetsUp( oBrwSets )
endif
case nKey == K_DOWN
if oBrwSets:Cargo < nSets
oBrwSets:Cargo++
SetsDown( oBrwSets )
endif
case nKey == K_HOME
if oBrwSets:Cargo > 1
oBrwSets:Cargo := 1
oBrwSets:GoTop()
oBrwSets:RefreshAll()
oBrwSets:ForceStable()
endif
case nKey == K_END
if oBrwSets:Cargo < nSets
oBrwSets:Cargo := nSets
oBrwSets:GoBottom()
oBrwSets:RefreshAll()
oBrwSets:ForceStable()
endif
Case nKey ==13
if nSet==oBrwSets:Cargo
if valtype(aArray[nSet,2])=="A"
if len( aArray[nSet,2])>0
TDBGArray():New(aArray[nSet,2],::pitems[nSet,1])
endif
elseif valtype(aArray[nSet,2])=="O"
tdbgObject():New(aArray[nSet,2],::pitems[nSet,1])
/* elseif __objHasMethod(::theObj,aArray[nSet,2])
Alert("Value cannot be edited")*/
elseif valtype(aArray[nSet,2])=="B"
Alert("Value cannot be edited")
else
oBrwSets:RefreshCurrent()
cTemp:=::doget(oBrwsets,::arrayreference,nSet)
oBrwSets:RefreshCurrent()
oBrwSets:ForceStable()
endif
endif
endcase
if nSet != oBrwSets:Cargo
::aWindows[::nCurwindow]:SetCaption(::objname +" is of class:" +::TheObj:classname() )
endif
myColors(oBrwsets,{1,2})
return
static procedure SetsUp( oBrw )
local nRow := oBrw:RowPos
local nSetPos
if oBrw:RowPos == 1
nSetPos := oBrw:Cargo
oBrw:Cargo := 0
oBrw:Refreshall()
oBrw:ForceStable()
oBrw:Cargo := nSetPos
endif
oBrw:colpos:=1
oBrw:dehilite()
oBrw:colpos:=2
oBrw:Up()
oBrw:Refreshall()
if nRow != oBrw:Cargo
oBrw:aReDraw[ nRow ] := .f.
oBrw:Up()
endif
oBrw:ForceStable()
myColors(oBrw,{1,2})
return
static procedure SetsDown( oBrw )
local nRow := oBrw:RowPos
local nSetPos
if oBrw:RowPos == oBrw:RowCount
nSetPos := oBrw:Cargo
oBrw:Cargo := 0
oBrw:Refreshall()
oBrw:ForceStable()
oBrw:Cargo := nSetPos
endif
oBrw:colpos:=1
oBrw:dehilite()
oBrw:colpos:=2
oBrw:Down()
oBrw:Refreshall()
if nRow != oBrw:Cargo
oBrw:aReDraw[ nRow ] := .f.
oBrw:Down()
endif
oBrw:ForceStable()
myColors(oBrw,{1,2})
return
static function ValToStr( uVal )
local cType := ValType( uVal )
local cResult := "U"
do case
case uVal == nil
cResult := "NIL"
case cType == "A"
cResult := "{ ... }"
case cType $ "CM"
cResult := '"' + uVal + '"'
case cType == "L"
cResult := iif( uVal, ".T.", ".F." )
case cType == "D"
cResult := DToC( uVal )
case cType == "N"
cResult := AllTrim( Str( uVal ) )
case cType == "O"
cResult := "Class " + uVal:ClassName() + " object"
Case cType =="B"
cResult:= "{ || ... }"
endcase
return cResult
METHOD doGet(oBro,pItem,nSet) class tdbgObject
LOCAL column, nKey
local getlist:={}
// save state
LOCAL lScoreSave := Set( _SET_SCOREBOARD, .f. )
LOCAL lExitSave := Set( _SET_EXIT, .t. )
LOCAL bInsSave := SetKey( K_INS )
// make sure browse is stable
obro:forcestable()
// if confirming new record, append blank
// set insert key to toggle insert mode and cursor
SetKey( K_INS, ;
{ || SetCursor( if(ReadInsert(!ReadInsert()), SC_NORMAL, SC_INSERT)) };
)
// initial cursor setting
SetCursor( IF( ReadInsert(), SC_INSERT, SC_NORMAL ) )
// get column object from browse
column := oBro:getColumn( oBro:colPos )
// create a corresponding GET
@ row(),col() get pitem[nSet,2]
// get := Getnew( Row(),col(), column:block,,, oBro:colorSpec )
// read it
ReadModal(getlist )
// eval(column:block,get:Buffer)
// restore state
SetCursor( 0 )
Set( _SET_SCOREBOARD, lScoreSave )
Set( _SET_EXIT, lExitSave )
SetKey( K_INS, bInsSave )
// check exit key from get
nKey := LastKey()
IF nKey == K_UP .OR. nKey == K_DOWN .OR. nKey == K_PGUP .OR. nKey == K_PGDN
KEYBOARD CHR( nKey )
END
RETURN
static function myColors( oBrowse, aColColors )
local i
local nColPos := oBrowse:colpos
for i := 1 to len( aColColors )
oBrowse:colpos := aColColors[i]
oBrowse:hilite()
if oBrowse:colPos==1
oBrowse:dehilite()
endif
next
oBrowse:colpos := nColPos
return Nil
FUNC maxelem( a )
LOCAL nSize := LEN( a )
LOCAL max := 0
LOCAL tam := 0
LOCAL nMax2 := 0
LOCAL nPos := 1
LOCAL cString
LOCAL nCount
FOR nCount := 1 TO nSize
tam := LEN( a[ nCount ] )
max := IF( tam > max, tam, max )
NEXT
RETURN max

66
harbour/source/debug/debugger.prg
View File

@@ -36,7 +36,7 @@
/* NOTE: Don't use SAY/DevOut()/DevPos() for screen output, otherwise
the debugger output may interfere with the applications output
redirection, and is also slower. [vszel] */
#pragma -es0
#include "hbclass.ch"
#include "hbmemvar.ch"
#include "box.ch"
@@ -314,10 +314,14 @@ METHOD EditVar( nVar ) CLASS TDebugger
do case
case uVarValue == "{ ... }"
// It is an array, don't do anything
if len(::avars[nVar][2])>0
__DbgArrays(::avars[nVar][2],cVarname)
else
Alert("Array is empty")
endif
case Upper( SubStr( uVarValue, 1, 5 ) ) == "CLASS"
// It is an object, don't do anything
__DbgObject(::avars[nVar][2],cVarname)
otherwise
::aVars[ nVar ][ 2 ] := &uVarValue
&( ::aVars[ nVar ][ 1 ] ) := ::aVars[ nVar ][ 2 ]
@@ -557,7 +561,7 @@ METHOD LoadVars() CLASS TDebugger // updates monitored variables
return nil
METHOD ShowVars() CLASS TDebugger
METHOD ShowVars(bSort,nType) CLASS TDebugger
local n
local nWidth
@@ -764,19 +768,23 @@ METHOD ViewSets() CLASS TDebugger
local nWidth := oWndSets:nRight - oWndSets:nLeft - 1
local oCol
oBrwSets:ColorSpec := "N/W, W+/W, N/BG"
oBrwSets:ColorSpec := "N/W, R/W, N/BG"
oBrwSets:GoTopBlock := { || n := 1 }
oBrwSets:GoBottomBlock := { || n := Len( aSets ) }
oBrwSets:SkipBlock := { | nSkip, nPos | nPos := n,;
n := iif( nSkip > 0, Min( Len( aSets ), n + nSkip ),;
Max( 1, n + nSkip ) ), n - nPos }
oBrwSets:AddColumn( TBColumnNew( "", { || PadR( aSets[ n ], 12 ) } ) )
oBrwSets:AddColumn( ocol := TBColumnNew( "", { || PadR( aSets[ n ], 12 ) } ) )
ocol:colorblock := { || { iif( n == oBrwSets:Cargo, 2, 1 ), 2 } }
oBrwSets:AddColumn( oCol := TBColumnNew( "",;
{ || PadR( ValToStr( Set( n ) ), nWidth - 13 ) } ) )
oBrwSets:Cargo := 1 // Actual highligthed row
oCol:ColorBlock := { || { iif( n == oBrwSets:Cargo, 3, 1 ), 3 } }
oBrwSets:colPos:=2
oBrwSets:Freeze:=1
ocol:ColorBlock := { || { iif( n == oBrwSets:Cargo, 3, 1 ), 3 } }
oWndSets:bPainted := { || oBrwSets:ForceStable() }
oWndSets:bPainted := { || oBrwSets:ForceStable(),myColors(oBrwsets,{1,2}) }
oWndSets:bKeyPressed := { | nKey | SetsKeyPressed( nKey, oBrwSets, Len( aSets ),;
oWndSets ) }
@@ -817,35 +825,40 @@ static procedure SetsKeyPressed( nKey, oBrwSets, nSets, oWnd )
oBrwSets:RefreshAll()
oBrwSets:ForceStable()
endif
/* case nKey == K_ENTER
::doGet(*/
endcase
if nSet != oBrwSets:Cargo
oWnd:SetCaption( "System Settings[" + AllTrim( Str( oBrwSets:Cargo ) ) + ;
"..47]" )
endif
myColors(oBrwsets,{1,2})
return
static procedure SetsUp( oBrw )
local nRow := oBrw:RowPos
local nSetPos
if oBrw:RowPos == 1
nSetPos := oBrw:Cargo
oBrw:Cargo := 0
oBrw:RefreshCurrent()
oBrw:Refreshall()
oBrw:ForceStable()
oBrw:Cargo := nSetPos
endif
oBrw:colpos:=1
oBrw:dehilite()
oBrw:colpos:=2
oBrw:Up()
oBrw:RefreshCurrent()
oBrw:Refreshall()
if nRow != oBrw:Cargo
oBrw:aReDraw[ nRow ] := .f.
endif
oBrw:Up()
endif
oBrw:ForceStable()
myColors(oBrw,{1,2})
return
static procedure SetsDown( oBrw )
@@ -856,18 +869,22 @@ static procedure SetsDown( oBrw )
if oBrw:RowPos == oBrw:RowCount
nSetPos := oBrw:Cargo
oBrw:Cargo := 0
oBrw:RefreshCurrent()
oBrw:Refreshall()
oBrw:ForceStable()
oBrw:Cargo := nSetPos
endif
oBrw:colpos:=1
oBrw:dehilite()
oBrw:colpos:=2
oBrw:Down()
oBrw:RefreshCurrent()
oBrw:Refreshall()
if nRow != oBrw:Cargo
oBrw:aReDraw[ nRow ] := .f.
oBrw:Down()
endif
oBrw:ForceStable()
myColors(oBrw,{1,2})
return
static function ValToStr( uVal )
@@ -882,6 +899,9 @@ static function ValToStr( uVal )
case cType == "A"
cResult := "{ ... }"
Case cType =="B"
cResult:= "{ || ... }"
case cType $ "CM"
cResult := '"' + uVal + '"'
@@ -899,3 +919,15 @@ static function ValToStr( uVal )
endcase
return cResult
static function myColors( oBrowse, aColColors )
local i
local nColPos := oBrowse:colpos
for i := 1 to len( aColColors )
oBrowse:colpos := aColColors[i]
oBrowse:DeHilite()
oBrowse:hilite()
next
oBrowse:colpos := nColPos
return Nil