From 4ee76b9b60691595ca01f58e8396dcf5438fb6c6 Mon Sep 17 00:00:00 2001 From: "David G. Holm" Date: Fri, 31 Mar 2000 23:26:27 +0000 Subject: [PATCH] See ChangeLog entry 2000-03-31 18:25 GMT-5 David G. Holm --- harbour/ChangeLog | 9 + harbour/source/debug/Makefile | 4 +- harbour/source/debug/dbgtmenu.prg | 431 +++++++++++++++++++++ harbour/source/debug/dbgtwin.prg | 256 +++++++++++++ harbour/source/debug/debugger.prg | 600 +----------------------------- 5 files changed, 700 insertions(+), 600 deletions(-) create mode 100644 harbour/source/debug/dbgtmenu.prg create mode 100644 harbour/source/debug/dbgtwin.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 49c2b57fd3..b22af5aa9e 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,12 @@ +2000-03-31 18:25 GMT-5 David G. Holm + * 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 * config/dos/bcc16.cf + It helps to use $(ARFLAGS) when running $(AR). diff --git a/harbour/source/debug/Makefile b/harbour/source/debug/Makefile index e2161fb3dd..6b6aa2b4f9 100644 --- a/harbour/source/debug/Makefile +++ b/harbour/source/debug/Makefile @@ -6,8 +6,10 @@ ROOT = ../../ PRG_SOURCES=\ dbgmenu.prg \ + dbgtmenu.prg \ + dbgtwin.prg \ debugger.prg \ - tbrwtext.prg + tbrwtext.prg \ LIBNAME=debug diff --git a/harbour/source/debug/dbgtmenu.prg b/harbour/source/debug/dbgtmenu.prg new file mode 100644 index 0000000000..a913c4bc88 --- /dev/null +++ b/harbour/source/debug/dbgtmenu.prg @@ -0,0 +1,431 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * The Debugger + * + * Copyright 1999 Antonio Linares + * 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 diff --git a/harbour/source/debug/dbgtwin.prg b/harbour/source/debug/dbgtwin.prg new file mode 100644 index 0000000000..6e1e87a4c7 --- /dev/null +++ b/harbour/source/debug/dbgtwin.prg @@ -0,0 +1,256 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * The Debugger + * + * Copyright 1999 Antonio Linares + * 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 diff --git a/harbour/source/debug/debugger.prg b/harbour/source/debug/debugger.prg index fdc1801a24..013d6bb4a6 100644 --- a/harbour/source/debug/debugger.prg +++ b/harbour/source/debug/debugger.prg @@ -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 -