See ChangeLog entry 2000-03-31 18:25 GMT-5 David G. Holm <dholm@jsd-llc.com>
This commit is contained in:
David G. Holm
@@ -1,3 +1,12 @@
|
||||
2000-03-31 18:25 GMT-5 David G. Holm <dholm@jsd-llc.com>
|
||||
* source/debug/Makefile
|
||||
+ source/debug/dbgtmenu.prg
|
||||
+ source/debug/dbgtwin.prg
|
||||
* source/debug/debugger.prg
|
||||
% I split the TDbWindow class into a new program module and
|
||||
the TDbMenu and TDbMenuItem classes into another so that
|
||||
Harbour can be built with dos/b16.
|
||||
|
||||
2000-03-31 18:00 GMT-5 David G. Holm <dholm@jsd-llc.com>
|
||||
* config/dos/bcc16.cf
|
||||
+ It helps to use $(ARFLAGS) when running $(AR).
|
||||
|
||||
@@ -6,8 +6,10 @@ ROOT = ../../
|
||||
|
||||
PRG_SOURCES=\
|
||||
dbgmenu.prg \
|
||||
dbgtmenu.prg \
|
||||
dbgtwin.prg \
|
||||
debugger.prg \
|
||||
tbrwtext.prg
|
||||
tbrwtext.prg \
|
||||
|
||||
LIBNAME=debug
|
||||
|
||||
|
||||
431
harbour/source/debug/dbgtmenu.prg
Normal file
431
harbour/source/debug/dbgtmenu.prg
Normal file
@@ -0,0 +1,431 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* The Debugger
|
||||
*
|
||||
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
|
||||
* 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/).
|
||||
*
|
||||
*/
|
||||
|
||||
/* 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] */
|
||||
|
||||
#include "hbclass.ch"
|
||||
#include "hbmemvar.ch"
|
||||
#include "box.ch"
|
||||
#include "inkey.ch"
|
||||
#include "common.ch"
|
||||
#include "setcurs.ch"
|
||||
|
||||
CLASS TDbMenu /* debugger menu */
|
||||
|
||||
CLASSDATA aMenus
|
||||
|
||||
DATA nTop, nLeft, nBottom, nRight
|
||||
DATA aItems
|
||||
DATA cClrHilite, cClrHotKey, cClrHotFocus, cClrPopup
|
||||
DATA nOpenPopup // zero if no popup is shown
|
||||
DATA lPopup
|
||||
DATA cBackImage
|
||||
|
||||
METHOD New( aItems )
|
||||
METHOD AddItem( oMenuItem )
|
||||
METHOD Build()
|
||||
METHOD ClosePopup()
|
||||
METHOD Close() INLINE ::ClosePopup( ::nOpenPopup ), ::nOpenPopup := 0
|
||||
METHOD DeHilite()
|
||||
METHOD Display()
|
||||
METHOD EvalAction()
|
||||
METHOD GetHotKeyPos( nKey )
|
||||
METHOD GetItemOrdByCoors( nRow, nCol )
|
||||
METHOD GoBottom()
|
||||
METHOD GoDown() INLINE ::aItems[ ::nOpenPopup ]:bAction:GoRight()
|
||||
METHOD GoLeft()
|
||||
METHOD GoRight()
|
||||
METHOD GoTop()
|
||||
METHOD GoUp() INLINE ::aItems[ ::nOpenPopup ]:bAction:GoLeft()
|
||||
METHOD IsOpen() INLINE ::nOpenPopup != 0
|
||||
METHOD ProcessKey( nKey )
|
||||
METHOD ShowPopup( nPopup )
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New() CLASS TDbMenu
|
||||
|
||||
local nCol := 0
|
||||
|
||||
if ::aMenus == nil
|
||||
::aMenus = {}
|
||||
::lPopup = .f.
|
||||
else
|
||||
::lPopup = .t.
|
||||
endif
|
||||
|
||||
::nTop = 0
|
||||
::nLeft = 0
|
||||
::nBottom = 0
|
||||
::nRight = 0
|
||||
::aItems = {}
|
||||
::cClrHilite = "W+/N"
|
||||
::cClrHotFocus = "GR+/N"
|
||||
::cClrHotKey = "GR+/BG"
|
||||
::cClrPopup = "N/BG"
|
||||
::nOpenPopup = 0
|
||||
|
||||
AAdd( ::aMenus, Self )
|
||||
|
||||
return Self
|
||||
|
||||
METHOD AddItem( oMenuItem ) CLASS TDbMenu
|
||||
|
||||
local oLastMenu := ATail( ::aMenus ), oLastMenuItem
|
||||
|
||||
if oLastMenu:lPopup
|
||||
oMenuItem:nRow = Len( oLastMenu:aItems )
|
||||
oMenuItem:nCol = oLastMenu:nLeft + 1
|
||||
else
|
||||
oMenuItem:nRow = 0
|
||||
if Len( oLastMenu:aItems ) > 0
|
||||
oLastMenuItem = ATail( oLastMenu:aItems )
|
||||
oMenuItem:nCol = oLastMenuItem:nCol + ;
|
||||
Len( StrTran( oLastMenuItem:cPrompt, "~", "" ) )
|
||||
else
|
||||
oMenuItem:nCol = 0
|
||||
endif
|
||||
endif
|
||||
|
||||
AAdd( ATail( ::aMenus ):aItems, oMenuItem )
|
||||
|
||||
return oMenuItem
|
||||
|
||||
METHOD Build() CLASS TDbMenu
|
||||
|
||||
local n, nPos := 0, oMenuItem
|
||||
|
||||
if Len( ::aMenus ) == 1 // pulldown menu
|
||||
for n = 1 to Len( ::aItems )
|
||||
::aItems[ n ]:nRow = 0
|
||||
::aItems[ n ]:nCol = nPos
|
||||
nPos += Len( StrTran( ::aItems[ n ]:cPrompt, "~", "" ) )
|
||||
next
|
||||
else
|
||||
oMenuItem = ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems )
|
||||
::nTop = oMenuItem:nRow + 1
|
||||
::nLeft = oMenuItem:nCol
|
||||
nPos = ::nLeft
|
||||
for n = 1 to Len( ::aItems )
|
||||
::aItems[ n ]:nRow = ::nTop + n
|
||||
::aItems[ n ]:nCol = ::nLeft + 1
|
||||
nPos = Max( nPos, ::nLeft + Len( StrTran( ::aItems[ n ]:cPrompt, "~", "" ) ) + 1 )
|
||||
next
|
||||
::nRight = nPos
|
||||
::nBottom = ::nTop + Len( ::aItems ) + 1
|
||||
for n = 1 to Len( ::aItems )
|
||||
if ::aItems[ n ]:cPrompt != "-"
|
||||
::aItems[ n ]:cPrompt = PadR( ::aItems[ n ]:cPrompt, ::nRight - ::nLeft )
|
||||
endif
|
||||
next
|
||||
ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems ):bAction = ATail( ::aMenus )
|
||||
::aMenus = ASize( ::aMenus, Len( ::aMenus ) - 1 )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD ClosePopup( nPopup ) CLASS TDbMenu
|
||||
|
||||
local oPopup
|
||||
|
||||
if nPopup != 0
|
||||
oPopup = ::aItems[ nPopup ]:bAction
|
||||
if oPopup:ClassName() == "TDBMENU"
|
||||
RestScreen( oPopup:nTop, oPopup:nLeft, oPopup:nBottom + 1, oPopup:nRight + 2,;
|
||||
oPopup:cBackImage )
|
||||
oPopup:cBackImage = nil
|
||||
endif
|
||||
::aItems[ nPopup ]:Display( ::cClrPopup, ::cClrHotKey )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD DeHilite() CLASS TDbMenu
|
||||
|
||||
local oMenuItem := ::aItems[ ::nOpenPopup ]
|
||||
|
||||
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
|
||||
|
||||
return nil
|
||||
|
||||
METHOD Display() CLASS TDbMenu
|
||||
|
||||
local n
|
||||
|
||||
SetColor( ::cClrPopup )
|
||||
|
||||
if ! ::lPopup
|
||||
DispOutAt( 0, 0, Space( MaxCol() + 1 ), ::cClrPopup )
|
||||
SetPos( 0, 0 )
|
||||
else
|
||||
::cBackImage = SaveScreen( ::nTop, ::nLeft, ::nBottom + 1, ::nRight + 2 )
|
||||
@ ::nTop, ::nLeft, ::nBottom, ::nRight BOX B_SINGLE
|
||||
hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight )
|
||||
endif
|
||||
|
||||
for n = 1 to Len( ::aItems )
|
||||
if ::aItems[ n ]:cPrompt == "-" // Separator
|
||||
DispOutAt( ::aItems[ n ]:nRow, ::nLeft,;
|
||||
Chr( 195 ) + Replicate( Chr( 196 ), ::nRight - ::nLeft - 1 ) + Chr( 180 ) )
|
||||
else
|
||||
::aItems[ n ]:Display( ::cClrPopup, ::cClrHotKey )
|
||||
endif
|
||||
next
|
||||
|
||||
return nil
|
||||
|
||||
METHOD EvalAction() CLASS TDbMenu
|
||||
|
||||
local oPopup, oMenuItem
|
||||
|
||||
oPopup = ::aItems[ ::nOpenPopup ]:bAction
|
||||
oMenuItem = oPopup:aItems[ oPopup:nOpenPopup ]
|
||||
|
||||
if oMenuItem:bAction != nil
|
||||
::Close()
|
||||
Eval( oMenuItem:bAction, oMenuItem )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD GetHotKeyPos( cKey ) CLASS TDbMenu
|
||||
|
||||
local n
|
||||
|
||||
for n = 1 to Len( ::aItems )
|
||||
if Upper( SubStr( ::aItems[ n ]:cPrompt,;
|
||||
At( "~", ::aItems[ n ]:cPrompt ) + 1, 1 ) ) == cKey
|
||||
return n
|
||||
endif
|
||||
next
|
||||
|
||||
return 0
|
||||
|
||||
METHOD GetItemOrdByCoors( nRow, nCol ) CLASS TDbMenu
|
||||
|
||||
local n
|
||||
|
||||
for n = 1 to Len( ::aItems )
|
||||
if ::aItems[ n ]:nRow == nRow .and. nCol >= ::aItems[ n ]:nCol .and. ;
|
||||
nCol <= ::aItems[ n ]:nCol + Len( ::aItems[ n ]:cPrompt ) - 2
|
||||
return n
|
||||
endif
|
||||
next
|
||||
|
||||
return 0
|
||||
|
||||
METHOD GoBottom() CLASS TDbMenu
|
||||
|
||||
local oPopup
|
||||
|
||||
if ::IsOpen()
|
||||
oPopup = ::aItems[ ::nOpenPopup ]:bAction
|
||||
oPopup:DeHilite()
|
||||
oPopup:ShowPopup( Len( oPopup:aItems ) )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD GoLeft() CLASS TDbMenu
|
||||
|
||||
local oMenuItem := ::aItems[ ::nOpenPopup ]
|
||||
|
||||
if ::nOpenPopup != 0
|
||||
if ! ::lPopup
|
||||
::ClosePopup( ::nOpenPopup )
|
||||
else
|
||||
oMenuItem:Display( ::cClrPopup, ::CClrHotKey )
|
||||
endif
|
||||
if ::nOpenPopup > 1
|
||||
--::nOpenPopup
|
||||
while ::nOpenPopup > 1 .and. ;
|
||||
SubStr( ::aItems[ ::nOpenPopup ]:cPrompt, 1, 1 ) == "-"
|
||||
--::nOpenPopup
|
||||
end
|
||||
::ShowPopup( ::nOpenPopup )
|
||||
else
|
||||
::ShowPopup( ::nOpenPopup := Len( ::aItems ) )
|
||||
endif
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD GoRight() CLASS TDbMenu
|
||||
|
||||
local oMenuItem := ::aItems[ ::nOpenPopup ]
|
||||
|
||||
if ::nOpenPopup != 0
|
||||
if ! ::lPopup
|
||||
::ClosePopup( ::nOpenPopup )
|
||||
else
|
||||
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
|
||||
endif
|
||||
if ::nOpenPopup < Len( ::aItems )
|
||||
++::nOpenPopup
|
||||
while ::nOpenPopup < Len( ::aItems ) .and. ;
|
||||
SubStr( ::aItems[ ::nOpenPopup ]:cPrompt, 1, 1 ) == "-"
|
||||
++::nOpenPopup
|
||||
end
|
||||
::ShowPopup( ::nOpenPopup )
|
||||
else
|
||||
::ShowPopup( ::nOpenPopup := 1 )
|
||||
endif
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD GoTop() CLASS TDbMenu
|
||||
|
||||
local oPopup
|
||||
|
||||
if ::IsOpen()
|
||||
oPopup = ::aItems[ ::nOpenPopup ]:bAction
|
||||
oPopup:DeHilite()
|
||||
oPopup:ShowPopup( 1 )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD ShowPopup( nPopup ) CLASS TDbMenu
|
||||
|
||||
::aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus )
|
||||
::nOpenPopup = nPopup
|
||||
|
||||
if ValType( ::aItems[ nPopup ]:bAction ) == "O"
|
||||
::aItems[ nPopup ]:bAction:Display()
|
||||
::aItems[ nPopup ]:bAction:ShowPopup( 1 )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD ProcessKey( nKey ) CLASS TDbMenu
|
||||
|
||||
local nPopup
|
||||
|
||||
do case
|
||||
case nKey == K_LBUTTONDOWN
|
||||
if MRow() == 0
|
||||
if ( nPopup := ::GetItemOrdByCoors( 0, MCol() ) ) != 0
|
||||
if nPopup != ::nOpenPopup
|
||||
::ClosePopup( ::nOpenPopup )
|
||||
::ShowPopup( nPopup )
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
|
||||
case nKey == K_ESC
|
||||
::Close()
|
||||
|
||||
case nKey == K_LEFT
|
||||
::GoLeft()
|
||||
|
||||
case nKey == K_RIGHT
|
||||
::GoRight()
|
||||
|
||||
case nKey == K_DOWN
|
||||
::GoDown()
|
||||
|
||||
case nKey == K_UP
|
||||
::GoUp()
|
||||
|
||||
case nKey == K_ENTER
|
||||
::EvalAction()
|
||||
|
||||
case nKey == K_HOME
|
||||
::GoTop()
|
||||
|
||||
case nKey == K_END
|
||||
::GoBottom()
|
||||
|
||||
otherwise
|
||||
if ( nPopup := ::GetHotKeyPos( AltToKey_debugger( nKey ) ) ) != 0
|
||||
if nPopup != ::nOpenPopup
|
||||
::Close()
|
||||
::ShowPopup( nPopup )
|
||||
endif
|
||||
endif
|
||||
endcase
|
||||
|
||||
return nil
|
||||
|
||||
CLASS TDbMenuItem
|
||||
|
||||
DATA nRow, nCol
|
||||
DATA cPrompt
|
||||
DATA bAction
|
||||
|
||||
METHOD New( cPrompt, bAction )
|
||||
METHOD Display( cClrText, cClrHotKey )
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New( cPrompt, bAction ) CLASS TDbMenuItem
|
||||
|
||||
::cPrompt = cPrompt
|
||||
::bAction = bAction
|
||||
|
||||
return Self
|
||||
|
||||
METHOD Display( cClrText, cClrHotKey ) CLASS TDbMenuItem
|
||||
|
||||
local nAt
|
||||
|
||||
DispOutAt( ::nRow, ::nCol ,;
|
||||
StrTran( ::cPrompt, "~", "" ), cClrText )
|
||||
|
||||
DispOutAt( ::nRow, ::nCol + ;
|
||||
( nAt := At( "~", ::cPrompt ) ) - 1,;
|
||||
SubStr( ::cPrompt, nAt + 1, 1 ), cClrHotKey )
|
||||
|
||||
return nil
|
||||
|
||||
function AltToKey_debugger( nKey )
|
||||
|
||||
local nIndex := AScan( { K_ALT_A, K_ALT_B, K_ALT_C, K_ALT_D, K_ALT_E, K_ALT_F,;
|
||||
K_ALT_G, K_ALT_H, K_ALT_I, K_ALT_J, K_ALT_K, K_ALT_L,;
|
||||
K_ALT_M, K_ALT_N, K_ALT_O, K_ALT_P, K_ALT_Q, K_ALT_R,;
|
||||
K_ALT_S, K_ALT_T, K_ALT_U, K_ALT_V, K_ALT_W, K_ALT_X,;
|
||||
K_ALT_Y, K_ALT_Z }, nKey )
|
||||
local cKey
|
||||
|
||||
if nIndex > 0
|
||||
cKey := SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ", nIndex, 1 )
|
||||
else
|
||||
cKey = ""
|
||||
endif
|
||||
|
||||
return cKey
|
||||
256
harbour/source/debug/dbgtwin.prg
Normal file
256
harbour/source/debug/dbgtwin.prg
Normal file
@@ -0,0 +1,256 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* The Debugger
|
||||
*
|
||||
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
|
||||
* 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/).
|
||||
*
|
||||
*/
|
||||
|
||||
/* 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] */
|
||||
|
||||
#include "hbclass.ch"
|
||||
#include "hbmemvar.ch"
|
||||
#include "box.ch"
|
||||
#include "inkey.ch"
|
||||
#include "common.ch"
|
||||
#include "setcurs.ch"
|
||||
|
||||
CLASS TDbWindow // Debugger windows and dialogs
|
||||
|
||||
DATA nTop, nLeft, nBottom, nRight
|
||||
DATA cCaption
|
||||
DATA cBackImage, cColor
|
||||
DATA lFocused, bGotFocus, bLostFocus
|
||||
DATA bKeyPressed, bPainted
|
||||
DATA lShadow
|
||||
DATA Cargo
|
||||
|
||||
METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor )
|
||||
METHOD Hide()
|
||||
METHOD IsOver( nRow, nCol )
|
||||
METHOD nWidth() INLINE ::nRight - ::nLeft + 1
|
||||
METHOD ScrollUp( nLines )
|
||||
METHOD SetCaption( cCaption )
|
||||
METHOD SetFocus( lOnOff )
|
||||
METHOD Show( lFocused )
|
||||
METHOD ShowModal()
|
||||
METHOD Move()
|
||||
METHOD KeyPressed( nKey )
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor ) CLASS TDbWindow
|
||||
|
||||
::nTop = nTop
|
||||
::nLeft = nLeft
|
||||
::nBottom = nBottom
|
||||
::nRight = nRight
|
||||
::cCaption = cCaption
|
||||
::cColor = cColor
|
||||
::lShadow = .f.
|
||||
|
||||
return Self
|
||||
|
||||
METHOD Hide() CLASS TDbWindow
|
||||
|
||||
RestScreen( ::nTop, ::nLeft, ::nBottom + If( ::lShadow, 1, 0 ),;
|
||||
::nRight + If( ::lShadow, 2, 0 ), ::cBackImage )
|
||||
::cBackImage = nil
|
||||
|
||||
return nil
|
||||
|
||||
METHOD IsOver( nRow, nCol ) CLASS TDbWindow
|
||||
|
||||
return nRow >= ::nTop .and. nRow <= ::nBottom .and. ;
|
||||
nCol >= ::nLeft .and. nCol <= ::nRight
|
||||
|
||||
METHOD ScrollUp( nLines ) CLASS TDbWindow
|
||||
|
||||
DEFAULT nLines TO 1
|
||||
|
||||
SetColor( ::cColor )
|
||||
Scroll( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1, nLines )
|
||||
|
||||
return nil
|
||||
|
||||
METHOD SetCaption( cCaption ) CLASS TDbWindow
|
||||
|
||||
local nOldLen := If( ::cCaption != nil, Len( ::cCaption ), 0 )
|
||||
|
||||
::cCaption = cCaption
|
||||
|
||||
if ! Empty( cCaption )
|
||||
DispOutAt( ::nTop, ::nLeft + ( ( ::nRight - ::nLeft ) / 2 ) - ;
|
||||
( ( Len( cCaption ) + 2 ) / 2 ),;
|
||||
" " + cCaption + " ", ::cColor )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD SetFocus( lOnOff ) CLASS TDbWindow
|
||||
|
||||
if ! lOnOff .and. ::bLostFocus != nil
|
||||
Eval( ::bLostFocus, Self )
|
||||
endif
|
||||
|
||||
DispBegin()
|
||||
|
||||
::lFocused = lOnOff
|
||||
|
||||
@ ::nTop, ::nLeft, ::nBottom, ::nRight BOX If( lOnOff, B_DOUBLE, B_SINGLE ) ;
|
||||
COLOR ::cColor
|
||||
|
||||
DispOutAt( ::nTop, ::nLeft + 1, "[" + Chr( 254 ) + "]", ::cColor )
|
||||
|
||||
if ! Empty( ::cCaption )
|
||||
::SetCaption( ::cCaption )
|
||||
endif
|
||||
|
||||
if ::bPainted != nil
|
||||
Eval( ::bPainted, Self )
|
||||
endif
|
||||
|
||||
DispEnd()
|
||||
|
||||
if lOnOff .and. ::bGotFocus != nil
|
||||
Eval( ::bGotFocus, Self )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD Show( lFocused ) CLASS TDbWindow
|
||||
|
||||
DEFAULT lFocused TO .f.
|
||||
|
||||
::cBackImage = SaveScreen( ::nTop, ::nLeft, ::nBottom + If( ::lShadow, 1, 0 ),;
|
||||
::nRight + If( ::lShadow, 2, 0 ) )
|
||||
SetColor( ::cColor )
|
||||
Scroll( ::nTop, ::nLeft, ::nBottom, ::nRight )
|
||||
::SetFocus( lFocused )
|
||||
|
||||
If ::lShadow
|
||||
hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD ShowModal() CLASS TDbWindow
|
||||
|
||||
local lExit := .f.
|
||||
local nKey
|
||||
|
||||
::lShadow = .t.
|
||||
::Show()
|
||||
|
||||
while ! lExit
|
||||
nKey = InKey( 0 )
|
||||
|
||||
if ::bKeyPressed != nil
|
||||
Eval( ::bKeyPressed, nKey )
|
||||
endif
|
||||
|
||||
do case
|
||||
case nKey == K_ESC
|
||||
lExit = .t.
|
||||
endcase
|
||||
end
|
||||
|
||||
::Hide()
|
||||
|
||||
return nil
|
||||
|
||||
/*Method move()
|
||||
Move a window across the screen
|
||||
Copyright Luiz Rafael Culik 1999
|
||||
*/
|
||||
METHOD Move() Class TDbWindow
|
||||
|
||||
local nOldTop := ::nTop
|
||||
local nOldLeft := ::nLeft
|
||||
local nOldBottom := ::nbottom
|
||||
local nOldRight := ::nright
|
||||
local nKey
|
||||
|
||||
while .t.
|
||||
RestScreen( ,,,, ::cbackimage )
|
||||
DispBox( ::nTop, ::nLeft, ::nRight, ::nBottom, Replicate( Chr( 176 ), 8 ) + " " )
|
||||
|
||||
nKey := Inkey( 0 )
|
||||
|
||||
do case
|
||||
case nkey == K_UP
|
||||
if ::ntop != 0
|
||||
::ntop--
|
||||
::nbottom--
|
||||
endif
|
||||
|
||||
case nKey == K_DOWN
|
||||
if ::nBottom != MaxRow()
|
||||
::nTop++
|
||||
::nBottom++
|
||||
endif
|
||||
|
||||
case nKey == K_LEFT
|
||||
if ::nLeft != 0
|
||||
::nLeft--
|
||||
::nRight--
|
||||
endif
|
||||
|
||||
case nKey == K_RIGHT
|
||||
if ::nBottom != MaxRow()
|
||||
::nLeft++
|
||||
::nRight++
|
||||
endif
|
||||
|
||||
case nKey == K_ESC
|
||||
::nTop := nOldTop
|
||||
::nLeft := nOldLeft
|
||||
::nBottom := nOldBottom
|
||||
::nRight := nOldRight
|
||||
endcase
|
||||
|
||||
if nKey == K_ESC .or. nKey == K_ENTER
|
||||
exit
|
||||
end
|
||||
end
|
||||
|
||||
// __keyboard( chr( 0 ) ), inkey() )
|
||||
|
||||
return nil
|
||||
|
||||
METHOD KeyPressed( nKey ) CLASS TDbWindow
|
||||
|
||||
if ::bKeyPressed != nil
|
||||
Eval( ::bKeyPressed, nKey, Self )
|
||||
endif
|
||||
|
||||
return nil
|
||||
@@ -421,7 +421,7 @@ METHOD HandleEvent() CLASS TDebugger
|
||||
::oWndCommand:KeyPressed( nKey )
|
||||
|
||||
otherwise
|
||||
if ( nPopup := ::oPullDown:GetHotKeyPos( AltToKey( nKey ) ) ) != 0
|
||||
if ( nPopup := ::oPullDown:GetHotKeyPos( AltToKey_debugger( nKey ) ) ) != 0
|
||||
if ::oPullDown:nOpenPopup != nPopup
|
||||
SetCursor( SC_NONE )
|
||||
::oPullDown:ShowPopup( nPopup )
|
||||
@@ -871,603 +871,6 @@ static function SetsDown( oBrw )
|
||||
|
||||
return nil
|
||||
|
||||
CLASS TDbWindow // Debugger windows and dialogs
|
||||
|
||||
DATA nTop, nLeft, nBottom, nRight
|
||||
DATA cCaption
|
||||
DATA cBackImage, cColor
|
||||
DATA lFocused, bGotFocus, bLostFocus
|
||||
DATA bKeyPressed, bPainted
|
||||
DATA lShadow
|
||||
DATA Cargo
|
||||
|
||||
METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor )
|
||||
METHOD Hide()
|
||||
METHOD IsOver( nRow, nCol )
|
||||
METHOD nWidth() INLINE ::nRight - ::nLeft + 1
|
||||
METHOD ScrollUp( nLines )
|
||||
METHOD SetCaption( cCaption )
|
||||
METHOD SetFocus( lOnOff )
|
||||
METHOD Show( lFocused )
|
||||
METHOD ShowModal()
|
||||
METHOD Move()
|
||||
METHOD KeyPressed( nKey )
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor ) CLASS TDbWindow
|
||||
|
||||
::nTop = nTop
|
||||
::nLeft = nLeft
|
||||
::nBottom = nBottom
|
||||
::nRight = nRight
|
||||
::cCaption = cCaption
|
||||
::cColor = cColor
|
||||
::lShadow = .f.
|
||||
|
||||
return Self
|
||||
|
||||
METHOD Hide() CLASS TDbWindow
|
||||
|
||||
RestScreen( ::nTop, ::nLeft, ::nBottom + If( ::lShadow, 1, 0 ),;
|
||||
::nRight + If( ::lShadow, 2, 0 ), ::cBackImage )
|
||||
::cBackImage = nil
|
||||
|
||||
return nil
|
||||
|
||||
METHOD IsOver( nRow, nCol ) CLASS TDbWindow
|
||||
|
||||
return nRow >= ::nTop .and. nRow <= ::nBottom .and. ;
|
||||
nCol >= ::nLeft .and. nCol <= ::nRight
|
||||
|
||||
METHOD ScrollUp( nLines ) CLASS TDbWindow
|
||||
|
||||
DEFAULT nLines TO 1
|
||||
|
||||
SetColor( ::cColor )
|
||||
Scroll( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1, nLines )
|
||||
|
||||
return nil
|
||||
|
||||
METHOD SetCaption( cCaption ) CLASS TDbWindow
|
||||
|
||||
local nOldLen := If( ::cCaption != nil, Len( ::cCaption ), 0 )
|
||||
|
||||
::cCaption = cCaption
|
||||
|
||||
if ! Empty( cCaption )
|
||||
DispOutAt( ::nTop, ::nLeft + ( ( ::nRight - ::nLeft ) / 2 ) - ;
|
||||
( ( Len( cCaption ) + 2 ) / 2 ),;
|
||||
" " + cCaption + " ", ::cColor )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD SetFocus( lOnOff ) CLASS TDbWindow
|
||||
|
||||
if ! lOnOff .and. ::bLostFocus != nil
|
||||
Eval( ::bLostFocus, Self )
|
||||
endif
|
||||
|
||||
DispBegin()
|
||||
|
||||
::lFocused = lOnOff
|
||||
|
||||
@ ::nTop, ::nLeft, ::nBottom, ::nRight BOX If( lOnOff, B_DOUBLE, B_SINGLE ) ;
|
||||
COLOR ::cColor
|
||||
|
||||
DispOutAt( ::nTop, ::nLeft + 1, "[" + Chr( 254 ) + "]", ::cColor )
|
||||
|
||||
if ! Empty( ::cCaption )
|
||||
::SetCaption( ::cCaption )
|
||||
endif
|
||||
|
||||
if ::bPainted != nil
|
||||
Eval( ::bPainted, Self )
|
||||
endif
|
||||
|
||||
DispEnd()
|
||||
|
||||
if lOnOff .and. ::bGotFocus != nil
|
||||
Eval( ::bGotFocus, Self )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD Show( lFocused ) CLASS TDbWindow
|
||||
|
||||
DEFAULT lFocused TO .f.
|
||||
|
||||
::cBackImage = SaveScreen( ::nTop, ::nLeft, ::nBottom + If( ::lShadow, 1, 0 ),;
|
||||
::nRight + If( ::lShadow, 2, 0 ) )
|
||||
SetColor( ::cColor )
|
||||
Scroll( ::nTop, ::nLeft, ::nBottom, ::nRight )
|
||||
::SetFocus( lFocused )
|
||||
|
||||
If ::lShadow
|
||||
hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD ShowModal() CLASS TDbWindow
|
||||
|
||||
local lExit := .f.
|
||||
local nKey
|
||||
|
||||
::lShadow = .t.
|
||||
::Show()
|
||||
|
||||
while ! lExit
|
||||
nKey = InKey( 0 )
|
||||
|
||||
if ::bKeyPressed != nil
|
||||
Eval( ::bKeyPressed, nKey )
|
||||
endif
|
||||
|
||||
do case
|
||||
case nKey == K_ESC
|
||||
lExit = .t.
|
||||
endcase
|
||||
end
|
||||
|
||||
::Hide()
|
||||
|
||||
return nil
|
||||
|
||||
/*Method move()
|
||||
Move a window across the screen
|
||||
Copyright Luiz Rafael Culik 1999
|
||||
*/
|
||||
METHOD Move() Class TDbWindow
|
||||
|
||||
local nOldTop := ::nTop
|
||||
local nOldLeft := ::nLeft
|
||||
local nOldBottom := ::nbottom
|
||||
local nOldRight := ::nright
|
||||
local nKey
|
||||
|
||||
while .t.
|
||||
RestScreen( ,,,, ::cbackimage )
|
||||
DispBox( ::nTop, ::nLeft, ::nRight, ::nBottom, Replicate( Chr( 176 ), 8 ) + " " )
|
||||
|
||||
nKey := Inkey( 0 )
|
||||
|
||||
do case
|
||||
case nkey == K_UP
|
||||
if ::ntop != 0
|
||||
::ntop--
|
||||
::nbottom--
|
||||
endif
|
||||
|
||||
case nKey == K_DOWN
|
||||
if ::nBottom != MaxRow()
|
||||
::nTop++
|
||||
::nBottom++
|
||||
endif
|
||||
|
||||
case nKey == K_LEFT
|
||||
if ::nLeft != 0
|
||||
::nLeft--
|
||||
::nRight--
|
||||
endif
|
||||
|
||||
case nKey == K_RIGHT
|
||||
if ::nBottom != MaxRow()
|
||||
::nLeft++
|
||||
::nRight++
|
||||
endif
|
||||
|
||||
case nKey == K_ESC
|
||||
::nTop := nOldTop
|
||||
::nLeft := nOldLeft
|
||||
::nBottom := nOldBottom
|
||||
::nRight := nOldRight
|
||||
endcase
|
||||
|
||||
if nKey == K_ESC .or. nKey == K_ENTER
|
||||
exit
|
||||
end
|
||||
end
|
||||
|
||||
// __keyboard( chr( 0 ) ), inkey() )
|
||||
|
||||
return nil
|
||||
|
||||
METHOD KeyPressed( nKey ) CLASS TDbWindow
|
||||
|
||||
if ::bKeyPressed != nil
|
||||
Eval( ::bKeyPressed, nKey, Self )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
CLASS TDbMenu /* debugger menu */
|
||||
|
||||
CLASSDATA aMenus
|
||||
|
||||
DATA nTop, nLeft, nBottom, nRight
|
||||
DATA aItems
|
||||
DATA cClrHilite, cClrHotKey, cClrHotFocus, cClrPopup
|
||||
DATA nOpenPopup // zero if no popup is shown
|
||||
DATA lPopup
|
||||
DATA cBackImage
|
||||
|
||||
METHOD New( aItems )
|
||||
METHOD AddItem( oMenuItem )
|
||||
METHOD Build()
|
||||
METHOD ClosePopup()
|
||||
METHOD Close() INLINE ::ClosePopup( ::nOpenPopup ), ::nOpenPopup := 0
|
||||
METHOD DeHilite()
|
||||
METHOD Display()
|
||||
METHOD EvalAction()
|
||||
METHOD GetHotKeyPos( nKey )
|
||||
METHOD GetItemOrdByCoors( nRow, nCol )
|
||||
METHOD GoBottom()
|
||||
METHOD GoDown() INLINE ::aItems[ ::nOpenPopup ]:bAction:GoRight()
|
||||
METHOD GoLeft()
|
||||
METHOD GoRight()
|
||||
METHOD GoTop()
|
||||
METHOD GoUp() INLINE ::aItems[ ::nOpenPopup ]:bAction:GoLeft()
|
||||
METHOD IsOpen() INLINE ::nOpenPopup != 0
|
||||
METHOD ProcessKey( nKey )
|
||||
METHOD ShowPopup( nPopup )
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New() CLASS TDbMenu
|
||||
|
||||
local nCol := 0
|
||||
|
||||
if ::aMenus == nil
|
||||
::aMenus = {}
|
||||
::lPopup = .f.
|
||||
else
|
||||
::lPopup = .t.
|
||||
endif
|
||||
|
||||
::nTop = 0
|
||||
::nLeft = 0
|
||||
::nBottom = 0
|
||||
::nRight = 0
|
||||
::aItems = {}
|
||||
::cClrHilite = "W+/N"
|
||||
::cClrHotFocus = "GR+/N"
|
||||
::cClrHotKey = "GR+/BG"
|
||||
::cClrPopup = "N/BG"
|
||||
::nOpenPopup = 0
|
||||
|
||||
AAdd( ::aMenus, Self )
|
||||
|
||||
return Self
|
||||
|
||||
METHOD AddItem( oMenuItem ) CLASS TDbMenu
|
||||
|
||||
local oLastMenu := ATail( ::aMenus ), oLastMenuItem
|
||||
|
||||
if oLastMenu:lPopup
|
||||
oMenuItem:nRow = Len( oLastMenu:aItems )
|
||||
oMenuItem:nCol = oLastMenu:nLeft + 1
|
||||
else
|
||||
oMenuItem:nRow = 0
|
||||
if Len( oLastMenu:aItems ) > 0
|
||||
oLastMenuItem = ATail( oLastMenu:aItems )
|
||||
oMenuItem:nCol = oLastMenuItem:nCol + ;
|
||||
Len( StrTran( oLastMenuItem:cPrompt, "~", "" ) )
|
||||
else
|
||||
oMenuItem:nCol = 0
|
||||
endif
|
||||
endif
|
||||
|
||||
AAdd( ATail( ::aMenus ):aItems, oMenuItem )
|
||||
|
||||
return oMenuItem
|
||||
|
||||
METHOD Build() CLASS TDbMenu
|
||||
|
||||
local n, nPos := 0, oMenuItem
|
||||
|
||||
if Len( ::aMenus ) == 1 // pulldown menu
|
||||
for n = 1 to Len( ::aItems )
|
||||
::aItems[ n ]:nRow = 0
|
||||
::aItems[ n ]:nCol = nPos
|
||||
nPos += Len( StrTran( ::aItems[ n ]:cPrompt, "~", "" ) )
|
||||
next
|
||||
else
|
||||
oMenuItem = ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems )
|
||||
::nTop = oMenuItem:nRow + 1
|
||||
::nLeft = oMenuItem:nCol
|
||||
nPos = ::nLeft
|
||||
for n = 1 to Len( ::aItems )
|
||||
::aItems[ n ]:nRow = ::nTop + n
|
||||
::aItems[ n ]:nCol = ::nLeft + 1
|
||||
nPos = Max( nPos, ::nLeft + Len( StrTran( ::aItems[ n ]:cPrompt, "~", "" ) ) + 1 )
|
||||
next
|
||||
::nRight = nPos
|
||||
::nBottom = ::nTop + Len( ::aItems ) + 1
|
||||
for n = 1 to Len( ::aItems )
|
||||
if ::aItems[ n ]:cPrompt != "-"
|
||||
::aItems[ n ]:cPrompt = PadR( ::aItems[ n ]:cPrompt, ::nRight - ::nLeft )
|
||||
endif
|
||||
next
|
||||
ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems ):bAction = ATail( ::aMenus )
|
||||
::aMenus = ASize( ::aMenus, Len( ::aMenus ) - 1 )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD ClosePopup( nPopup ) CLASS TDbMenu
|
||||
|
||||
local oPopup
|
||||
|
||||
if nPopup != 0
|
||||
oPopup = ::aItems[ nPopup ]:bAction
|
||||
if oPopup:ClassName() == "TDBMENU"
|
||||
RestScreen( oPopup:nTop, oPopup:nLeft, oPopup:nBottom + 1, oPopup:nRight + 2,;
|
||||
oPopup:cBackImage )
|
||||
oPopup:cBackImage = nil
|
||||
endif
|
||||
::aItems[ nPopup ]:Display( ::cClrPopup, ::cClrHotKey )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD DeHilite() CLASS TDbMenu
|
||||
|
||||
local oMenuItem := ::aItems[ ::nOpenPopup ]
|
||||
|
||||
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
|
||||
|
||||
return nil
|
||||
|
||||
METHOD Display() CLASS TDbMenu
|
||||
|
||||
local n
|
||||
|
||||
SetColor( ::cClrPopup )
|
||||
|
||||
if ! ::lPopup
|
||||
DispOutAt( 0, 0, Space( MaxCol() + 1 ), ::cClrPopup )
|
||||
SetPos( 0, 0 )
|
||||
else
|
||||
::cBackImage = SaveScreen( ::nTop, ::nLeft, ::nBottom + 1, ::nRight + 2 )
|
||||
@ ::nTop, ::nLeft, ::nBottom, ::nRight BOX B_SINGLE
|
||||
hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight )
|
||||
endif
|
||||
|
||||
for n = 1 to Len( ::aItems )
|
||||
if ::aItems[ n ]:cPrompt == "-" // Separator
|
||||
DispOutAt( ::aItems[ n ]:nRow, ::nLeft,;
|
||||
Chr( 195 ) + Replicate( Chr( 196 ), ::nRight - ::nLeft - 1 ) + Chr( 180 ) )
|
||||
else
|
||||
::aItems[ n ]:Display( ::cClrPopup, ::cClrHotKey )
|
||||
endif
|
||||
next
|
||||
|
||||
return nil
|
||||
|
||||
METHOD EvalAction() CLASS TDbMenu
|
||||
|
||||
local oPopup, oMenuItem
|
||||
|
||||
oPopup = ::aItems[ ::nOpenPopup ]:bAction
|
||||
oMenuItem = oPopup:aItems[ oPopup:nOpenPopup ]
|
||||
|
||||
if oMenuItem:bAction != nil
|
||||
::Close()
|
||||
Eval( oMenuItem:bAction, oMenuItem )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD GetHotKeyPos( cKey ) CLASS TDbMenu
|
||||
|
||||
local n
|
||||
|
||||
for n = 1 to Len( ::aItems )
|
||||
if Upper( SubStr( ::aItems[ n ]:cPrompt,;
|
||||
At( "~", ::aItems[ n ]:cPrompt ) + 1, 1 ) ) == cKey
|
||||
return n
|
||||
endif
|
||||
next
|
||||
|
||||
return 0
|
||||
|
||||
METHOD GetItemOrdByCoors( nRow, nCol ) CLASS TDbMenu
|
||||
|
||||
local n
|
||||
|
||||
for n = 1 to Len( ::aItems )
|
||||
if ::aItems[ n ]:nRow == nRow .and. nCol >= ::aItems[ n ]:nCol .and. ;
|
||||
nCol <= ::aItems[ n ]:nCol + Len( ::aItems[ n ]:cPrompt ) - 2
|
||||
return n
|
||||
endif
|
||||
next
|
||||
|
||||
return 0
|
||||
|
||||
METHOD GoBottom() CLASS TDbMenu
|
||||
|
||||
local oPopup
|
||||
|
||||
if ::IsOpen()
|
||||
oPopup = ::aItems[ ::nOpenPopup ]:bAction
|
||||
oPopup:DeHilite()
|
||||
oPopup:ShowPopup( Len( oPopup:aItems ) )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD GoLeft() CLASS TDbMenu
|
||||
|
||||
local oMenuItem := ::aItems[ ::nOpenPopup ]
|
||||
|
||||
if ::nOpenPopup != 0
|
||||
if ! ::lPopup
|
||||
::ClosePopup( ::nOpenPopup )
|
||||
else
|
||||
oMenuItem:Display( ::cClrPopup, ::CClrHotKey )
|
||||
endif
|
||||
if ::nOpenPopup > 1
|
||||
--::nOpenPopup
|
||||
while ::nOpenPopup > 1 .and. ;
|
||||
SubStr( ::aItems[ ::nOpenPopup ]:cPrompt, 1, 1 ) == "-"
|
||||
--::nOpenPopup
|
||||
end
|
||||
::ShowPopup( ::nOpenPopup )
|
||||
else
|
||||
::ShowPopup( ::nOpenPopup := Len( ::aItems ) )
|
||||
endif
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD GoRight() CLASS TDbMenu
|
||||
|
||||
local oMenuItem := ::aItems[ ::nOpenPopup ]
|
||||
|
||||
if ::nOpenPopup != 0
|
||||
if ! ::lPopup
|
||||
::ClosePopup( ::nOpenPopup )
|
||||
else
|
||||
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
|
||||
endif
|
||||
if ::nOpenPopup < Len( ::aItems )
|
||||
++::nOpenPopup
|
||||
while ::nOpenPopup < Len( ::aItems ) .and. ;
|
||||
SubStr( ::aItems[ ::nOpenPopup ]:cPrompt, 1, 1 ) == "-"
|
||||
++::nOpenPopup
|
||||
end
|
||||
::ShowPopup( ::nOpenPopup )
|
||||
else
|
||||
::ShowPopup( ::nOpenPopup := 1 )
|
||||
endif
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD GoTop() CLASS TDbMenu
|
||||
|
||||
local oPopup
|
||||
|
||||
if ::IsOpen()
|
||||
oPopup = ::aItems[ ::nOpenPopup ]:bAction
|
||||
oPopup:DeHilite()
|
||||
oPopup:ShowPopup( 1 )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD ShowPopup( nPopup ) CLASS TDbMenu
|
||||
|
||||
::aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus )
|
||||
::nOpenPopup = nPopup
|
||||
|
||||
if ValType( ::aItems[ nPopup ]:bAction ) == "O"
|
||||
::aItems[ nPopup ]:bAction:Display()
|
||||
::aItems[ nPopup ]:bAction:ShowPopup( 1 )
|
||||
endif
|
||||
|
||||
return nil
|
||||
|
||||
METHOD ProcessKey( nKey ) CLASS TDbMenu
|
||||
|
||||
local nPopup
|
||||
|
||||
do case
|
||||
case nKey == K_LBUTTONDOWN
|
||||
if MRow() == 0
|
||||
if ( nPopup := ::GetItemOrdByCoors( 0, MCol() ) ) != 0
|
||||
if nPopup != ::nOpenPopup
|
||||
::ClosePopup( ::nOpenPopup )
|
||||
::ShowPopup( nPopup )
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
|
||||
case nKey == K_ESC
|
||||
::Close()
|
||||
|
||||
case nKey == K_LEFT
|
||||
::GoLeft()
|
||||
|
||||
case nKey == K_RIGHT
|
||||
::GoRight()
|
||||
|
||||
case nKey == K_DOWN
|
||||
::GoDown()
|
||||
|
||||
case nKey == K_UP
|
||||
::GoUp()
|
||||
|
||||
case nKey == K_ENTER
|
||||
::EvalAction()
|
||||
|
||||
case nKey == K_HOME
|
||||
::GoTop()
|
||||
|
||||
case nKey == K_END
|
||||
::GoBottom()
|
||||
|
||||
otherwise
|
||||
if ( nPopup := ::GetHotKeyPos( AltToKey( nKey ) ) ) != 0
|
||||
if nPopup != ::nOpenPopup
|
||||
::Close()
|
||||
::ShowPopup( nPopup )
|
||||
endif
|
||||
endif
|
||||
endcase
|
||||
|
||||
return nil
|
||||
|
||||
CLASS TDbMenuItem
|
||||
|
||||
DATA nRow, nCol
|
||||
DATA cPrompt
|
||||
DATA bAction
|
||||
|
||||
METHOD New( cPrompt, bAction )
|
||||
METHOD Display( cClrText, cClrHotKey )
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New( cPrompt, bAction ) CLASS TDbMenuItem
|
||||
|
||||
::cPrompt = cPrompt
|
||||
::bAction = bAction
|
||||
|
||||
return Self
|
||||
|
||||
METHOD Display( cClrText, cClrHotKey ) CLASS TDbMenuItem
|
||||
|
||||
local nAt
|
||||
|
||||
DispOutAt( ::nRow, ::nCol ,;
|
||||
StrTran( ::cPrompt, "~", "" ), cClrText )
|
||||
|
||||
DispOutAt( ::nRow, ::nCol + ;
|
||||
( nAt := At( "~", ::cPrompt ) ) - 1,;
|
||||
SubStr( ::cPrompt, nAt + 1, 1 ), cClrHotKey )
|
||||
|
||||
return nil
|
||||
|
||||
static function AltToKey( nKey )
|
||||
|
||||
local nIndex := AScan( { K_ALT_A, K_ALT_B, K_ALT_C, K_ALT_D, K_ALT_E, K_ALT_F,;
|
||||
K_ALT_G, K_ALT_H, K_ALT_I, K_ALT_J, K_ALT_K, K_ALT_L,;
|
||||
K_ALT_M, K_ALT_N, K_ALT_O, K_ALT_P, K_ALT_Q, K_ALT_R,;
|
||||
K_ALT_S, K_ALT_T, K_ALT_U, K_ALT_V, K_ALT_W, K_ALT_X,;
|
||||
K_ALT_Y, K_ALT_Z }, nKey )
|
||||
local cKey
|
||||
|
||||
if nIndex > 0
|
||||
cKey := SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ", nIndex, 1 )
|
||||
else
|
||||
cKey = ""
|
||||
endif
|
||||
|
||||
return cKey
|
||||
|
||||
static function ValToStr( uVal )
|
||||
|
||||
local cType := ValType( uVal )
|
||||
@@ -1497,4 +900,3 @@ static function ValToStr( uVal )
|
||||
endcase
|
||||
|
||||
return cResult
|
||||
|
||||
|
||||
Reference in New Issue
Block a user