xLINK: error: Unresolved external symbol '_HB_FUN_HB_LEFTEQ referenced from (dbgtmenu.obj)'.
xLINK: fatal error: 1 unresolved external(s).
┌───────────────────────────────────────────────────────────┐
│ Error BASE/1004 Class: 'NIL' has no exported method: │
│ SHOWPOPUP Arguments: ( [ 1] = Type: U [ 2] = Type: N Val: │
│ 1) │
│ │
│ Quit │
└───────────────────────────────────────────────────────────┘
#pragma -b-
#xcommand MENU [<oMenu>] => [ <oMenu> := ] HBDbMenu():New()
#xcommand MENUITEM [ <oMenuItem> PROMPT ] <cPrompt> ;
[ IDENT <nIdent> ] [ ACTION <uAction,...> ] ;
[ CHECKED <bChecked> ] => ;
[ <oMenuItem> := ] HBDbMenu():AddItem( HBDbMenuItem():New( <cPrompt>,;
[{||<uAction>}], [<bChecked>], [<nIdent>] ) )
#xcommand SEPARATOR => HBDbMenu():AddItem( HBDbMenuItem():New( "-" ) )
#xcommand ENDMENU => ATail( HBDbMenu():aMenus ):Build()
PROCEDURE Main
LOCAL oMenu
SETMODE( 25,80 )
SET CURSOR OFF
SET COLOR TO "W/B"
CLEAR SCREEN
oMenu = __dbgBuildMenu()
oMenu:Display()
oMenu:ShowPopup( 1 )
while oMenu:nOpenPopup != 0
oMenu:ProcessKey( Inkey( 0 ) )
end
RETURN
// EOP: Main
FUNCTION __dbgBuildMenu() // Builds the debugger pulldown menu
LOCAL oMenu
MENU oMenu
MENUITEM " ~File "
MENU
MENUITEM " ~Open..." ACTION ALERT( "open" )
MENUITEM " ~Resume" ACTION ALERT( "open" )
MENUITEM " O~S Shell" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " e~Xit Alt-X " ACTION oMenu:Close()
ENDMENU
MENUITEM " ~Locate "
MENU
MENUITEM " ~Find" ACTION ALERT( "open" )
MENUITEM " ~Next" ACTION ALERT( "open" )
MENUITEM " ~Previous" ACTION ALERT( "open" )
MENUITEM " ~Goto line..." ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~Case sensitive " IDENT "CASE" ;
ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~View "
MENU
MENUITEM " ~Sets" ACTION ALERT( "open" )
MENUITEM " ~WorkAreas F6" ACTION ALERT( "open" )
MENUITEM " ~App Screen F4 " ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~CallStack" IDENT "CALLSTACK" ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Run "
MENU
MENUITEM " ~Animate" IDENT "ANIMATE" ACTION ALERT( "open" )
MENUITEM " ~Step F8" ACTION ALERT( "open" )
MENUITEM " ~Trace F10" ACTION ALERT( "open" )
MENUITEM " ~Go F5" ACTION ALERT( "open" )
MENUITEM " to ~Cursor F7" ACTION ALERT( "open" )
MENUITEM " ~Next routine Ctrl-F5" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " s~Peed..." ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Point "
MENU
MENUITEM " ~Watchpoint..." ACTION ALERT( "open" )
MENUITEM " ~Tracepoint..." ACTION ALERT( "open" )
MENUITEM " ~Breakpoint F9 " ACTION ALERT( "open" )
MENUITEM " ~Delete..." ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Monitor "
MENU
MENUITEM " ~Public" IDENT "PUBLIC" ACTION ALERT( "open" )
MENUITEM " pri~Vate " IDENT "PRIVATE" ACTION ALERT( "open" )
MENUITEM " ~Static" IDENT "STATIC" ACTION ALERT( "open" )
MENUITEM " ~Local" IDENT "LOCAL" ACTION ALERT( "open" )
MENUITEM " ~Global" IDENT "GLOBAL" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~All" IDENT "ALL" ACTION ALERT( "open" )
MENUITEM " S~how all Globals" IDENT "SHOWALLGLOBALS" ACTION ALERT( "open" )
MENUITEM " s~Ort" ACTION Alert( "open" )
ENDMENU
MENUITEM " ~Options "
MENU
MENUITEM " ~Preprocessed Code" IDENT "PPO" ACTION ALERT( "open" )
MENUITEM " ~Line Numbers" IDENT "LINE" ACTION ALERT( "open" )
MENUITEM " ~Exchange Screens" ACTION ALERT( "open" )
MENUITEM " swap on ~Input" ACTION ALERT( "open" )
MENUITEM " code~Block Trace" IDENT "CODEBLOCK" ACTION ALERT( "open" )
MENUITEM " ~Menu Bar" ACTION ALERT( "open" )
MENUITEM " mono ~Display" IDENT "MONO" ACTION ALERT( "open" )
MENUITEM " ~Colors..." ACTION ALERT( "open" )
MENUITEM " ~Tab Width..." ACTION ALERT( "open" )
MENUITEM " path for ~Files..." ACTION ALERT( "open" )
MENUITEM " R~un at startup" IDENT "ALTD" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~Save Settings..." ACTION ALERT( "open" )
MENUITEM " ~Restore Settings... " ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Window "
MENU
MENUITEM " ~Next Tab " ACTION ALERT( "open" )
MENUITEM " ~Prev Sh-Tab" ACTION ALERT( "open" )
MENUITEM " ~Move" ACTION ALERT( "open" )
MENUITEM " ~Size" ACTION ALERT( "open" )
MENUITEM " ~Zoom F2" ACTION ALERT( "open" )
MENUITEM " ~Iconize" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~Tile" ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Help "
MENU
MENUITEM " ~About Help " ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~Keys" ACTION ALERT( "open" )
MENUITEM " ~Windows" ACTION ALERT( "open" )
MENUITEM " ~Menus" ACTION ALERT( "open" )
MENUITEM " ~Commands" ACTION ALERT( "open" )
ENDMENU
ENDMENU
RETURN oMenu
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
#include "hbclass.ch"
#include "hbmemvar.ch"
#include "box.ch"
#include "inkey.ch"
#include "setcurs.ch"
CREATE CLASS HBDbMenu
METHOD aMenus SETGET
VAR nTop
VAR nLeft
VAR nBottom
VAR nRight
VAR aItems
VAR cClrHilite
VAR cClrHotKey
VAR cClrHotFocus
VAR cClrPopup
VAR nOpenPopup // zero if no popup is shown
VAR lPopup
VAR cBackImage
METHOD New()
METHOD AddItem( oMenuItem )
METHOD Build()
METHOD ClosePopup( nPopup )
METHOD CLOSE() INLINE ::ClosePopup( ::nOpenPopup ), ::nOpenPopup := 0
METHOD DeHilite()
METHOD DISPLAY()
METHOD EvalAction()
METHOD GetHotKeyPos( cKey )
METHOD GetItemByIdent( uIdent )
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 LoadColors() // Load current debugger colors settings
METHOD ProcessKey( nKey )
METHOD Refresh() // Repaints the top bar
METHOD ShowPopup( nPopup )
ENDCLASS
METHOD aMenus( xNewVal ) CLASS HBDbMenu
STATIC t_aMenus
IF PCount() > 0
t_aMenus := xNewVal
ENDIF
RETURN t_aMenus
METHOD New() CLASS HBDbMenu
IF ::aMenus == NIL
::aMenus := {}
::lPopup := .F.
ELSE
::lPopup := .T.
ENDIF
::nTop := 0
::nLeft := 0
::nBottom := 0
::nRight := 0
::aItems := {}
::LoadColors()
::nOpenPopup := 0
AAdd( ::aMenus, Self )
RETURN Self
METHOD AddItem( oMenuItem ) CLASS HBDbMenu
LOCAL oLastMenu := ATail( ::aMenus )
LOCAL 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 HBDbMenu
LOCAL nPos := 0
LOCAL oMenuItem, n
IF Len( ::aMenus ) == 1 // pulldown menu
FOR EACH oMenuItem IN ::aItems
oMenuItem:nRow := 0
oMenuItem:nCol := nPos
nPos += Len( StrTran( oMenuItem: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 + 1
::nBottom := ::nTop + Len( ::aItems ) + 1
FOR EACH oMenuItem IN ::aItems
IF ! hb_LeftEq( oMenuItem:cPrompt, "-" )
oMenuItem:cPrompt := " " + PadR( oMenuItem:cPrompt, ::nRight - ::nLeft - 1 )
ENDIF
NEXT
ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems ):bAction := ATail( ::aMenus )
::aMenus := ASize( ::aMenus, Len( ::aMenus ) - 1 )
ENDIF
RETURN nil
METHOD ClosePopup( nPopup ) CLASS HBDbMenu
LOCAL oPopup
IF nPopup != 0
oPopup := ::aItems[ nPopup ]:bAction
IF HB_ISOBJECT( oPopup )
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 HBDbMenu
LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
RETURN nil
METHOD Display() CLASS HBDbMenu
LOCAL oMenuItem
IF ::lPopup
::cBackImage := SaveScreen( ::nTop, ::nLeft, ::nBottom + 1, ::nRight + 2 )
hb_DispBox( ::nTop, ::nLeft, ::nBottom, ::nRight, HB_B_SINGLE_UNI, ::cClrPopup )
hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight )
ELSE
hb_Scroll( 0, 0, 0, MaxCol(),,, ::cClrPopup )
ENDIF
FOR EACH oMenuItem IN ::aItems
IF oMenuItem:cPrompt == "-" // Separator
hb_DispOutAtBox( oMenuItem:nRow, ::nLeft, ;
hb_UTF8ToStrBox( "?" + Replicate( "?", ::nRight - ::nLeft - 1 ) + "?" ), ::cClrPopup )
ELSE
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
ENDIF
NEXT
RETURN nil
METHOD EvalAction() CLASS HBDbMenu
LOCAL oPopup := ::aItems[ ::nOpenPopup ]:bAction
LOCAL oMenuItem := oPopup:aItems[ oPopup:nOpenPopup ]
IF oMenuItem:bAction != NIL
::Close()
Eval( oMenuItem:bAction, oMenuItem )
ENDIF
RETURN nil
METHOD GetHotKeyPos( cKey ) CLASS HBDbMenu
LOCAL oMenuItem
FOR EACH oMenuItem IN ::aItems
IF Upper( SubStr( oMenuItem:cPrompt, ;
At( "~", oMenuItem:cPrompt ) + 1, 1 ) ) == cKey
RETURN oMenuItem:__enumIndex()
ENDIF
NEXT
RETURN 0
METHOD GetItemOrdByCoors( nRow, nCol ) CLASS HBDbMenu
LOCAL oMenuItem
FOR EACH oMenuItem IN ::aItems
IF oMenuItem:nRow == nRow .AND. nCol >= oMenuItem:nCol .AND. ;
nCol <= oMenuItem:nCol + Len( oMenuItem:cPrompt ) - 2
RETURN oMenuItem:__enumIndex()
ENDIF
NEXT
RETURN 0
METHOD GetItemByIdent( uIdent ) CLASS HBDbMenu
LOCAL oMenuItem
LOCAL oItem
FOR EACH oMenuItem IN ::aItems
IF HB_ISOBJECT( oMenuItem:bAction )
IF ( oItem := oMenuItem:bAction:GetItemByIdent( uIdent ) ) != NIL
RETURN oItem
ENDIF
ELSEIF ValType( oMenuItem:Ident ) == ValType( uIdent ) .AND. ;
oMenuItem:Ident == uIdent
RETURN oMenuItem
ENDIF
NEXT
RETURN NIL
METHOD GoBottom() CLASS HBDbMenu
LOCAL oPopup
IF ::IsOpen()
oPopup := ::aItems[ ::nOpenPopup ]:bAction
oPopup:DeHilite()
oPopup:ShowPopup( Len( oPopup:aItems ) )
ENDIF
RETURN nil
METHOD GoLeft() CLASS HBDbMenu
LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]
IF ::nOpenPopup != 0
IF ::lPopup
oMenuItem:Display( ::cClrPopup, ::CClrHotKey )
ELSE
::ClosePopup( ::nOpenPopup )
ENDIF
IF ::nOpenPopup > 1
--::nOpenPopup
DO WHILE ::nOpenPopup > 1 .AND. ;
hb_LeftEq( ::aItems[ ::nOpenPopup ]:cPrompt, "-" )
--::nOpenPopup
ENDDO
::ShowPopup( ::nOpenPopup )
ELSE
::ShowPopup( ::nOpenPopup := Len( ::aItems ) )
ENDIF
ENDIF
RETURN nil
METHOD GoRight() CLASS HBDbMenu
LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]
IF ::nOpenPopup != 0
IF ::lPopup
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
ELSE
::ClosePopup( ::nOpenPopup )
ENDIF
IF ::nOpenPopup < Len( ::aItems )
++::nOpenPopup
DO WHILE ::nOpenPopup < Len( ::aItems ) .AND. ;
hb_LeftEq( ::aItems[ ::nOpenPopup ]:cPrompt, "-" )
++::nOpenPopup
ENDDO
::ShowPopup( ::nOpenPopup )
ELSE
::ShowPopup( ::nOpenPopup := 1 )
ENDIF
ENDIF
RETURN nil
METHOD GoTop() CLASS HBDbMenu
LOCAL oPopup
IF ::IsOpen()
oPopup := ::aItems[ ::nOpenPopup ]:bAction
oPopup:DeHilite()
oPopup:ShowPopup( 1 )
ENDIF
RETURN nil
METHOD LoadColors() CLASS HBDbMenu
LOCAL aColors := { "W+/B", "BG+/R", "GR+/B", "GR+/R", "N+/BG", "GR+/B", ;
"BR+/B", "W/G", "R+/B", "BG+/N", "BG/N" }
LOCAL oMenuItem
::cClrPopup := aColors[ 8 ]
::cClrHotKey := aColors[ 9 ]
::cClrHilite := aColors[ 10 ]
::cClrHotFocus := aColors[ 11 ]
FOR EACH oMenuItem IN ::aItems
IF HB_ISOBJECT( oMenuItem:bAction )
oMenuItem:bAction:LoadColors()
ENDIF
NEXT
RETURN nil
METHOD Refresh() CLASS HBDbMenu
LOCAL oMenuItem
DispBegin()
IF ! ::lPopup
hb_Scroll( 0, 0, 0, MaxCol(),,, ::cClrPopup )
ENDIF
FOR EACH oMenuItem IN ::aItems
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
NEXT
DispEnd()
RETURN nil
METHOD ShowPopup( nPopup ) CLASS HBDbMenu
::aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus )
::nOpenPopup := nPopup
IF HB_ISOBJECT( ::aItems[ nPopup ]:bAction )
::aItems[ nPopup ]:bAction:Display()
::aItems[ nPopup ]:bAction:ShowPopup( 1 )
ENDIF
RETURN nil
METHOD ProcessKey( nKey ) CLASS HBDbMenu
LOCAL nPopup
LOCAL oPopup
do case
CASE nKey == K_LBUTTONDOWN
IF MRow() == 0
IF ( nPopup := ::GetItemOrdByCoors( 0, MCol() ) ) != 0
IF nPopup != ::nOpenPopup
::ClosePopup( ::nOpenPopup )
::ShowPopup( nPopup )
ENDIF
ENDIF
ELSE
oPopup := ::aItems[ ::nOpenPopup ]:bAction
IF ( nPopup := oPopup:GetItemOrdByCoors( MRow(), MCol() ) ) == 0
::Close()
ELSE
oPopup:DeHilite()
oPopup:nOpenPopup := nPopup
oPopup:aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus )
::EvalAction()
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 ::nOpenPopup > 0
IF IsAlpha( hb_keyChar( nKey ) )
oPopup := ::aItems[ ::nOpenPopup ]:bAction
IF ( nPopup := oPopup:GetHotKeyPos( Upper( hb_keyChar( nKey ) ) ) ) > 0
IF oPopup:nOpenPopup != nPopup
oPopup:DeHilite()
oPopup:ShowPopup( nPopup )
ENDIF
::EvalAction()
ENDIF
ENDIF
ELSEIF ( nPopup := ::GetHotKeyPos( __dbgAltToKey( nKey ) ) ) != ::nOpenPopup
::Close()
::ShowPopup( nPopup )
ENDIF
END
RETURN nil
FUNCTION __dbgAltToKey( 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, K_ALT_1, K_ALT_2, K_ALT_3, K_ALT_4, ;
K_ALT_5, K_ALT_6, K_ALT_7, K_ALT_8, K_ALT_9, K_ALT_0 }, nKey )
RETURN iif( nIndex > 0, SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890", nIndex, 1 ), "" )
function HB_LEFTEQ( c1, c2 ) ; return Left( c1, Len( c2 ) ) == c2
// function HB_DISPOUTATBOX() ; return nil
function HB_UTF8TOSTRBOX() ; return nil
function HB_KEYCHAR() ; return nil
#pragma -b-
#xcommand MENU [<oMenu>] => [ <oMenu> := ] HBDbMenu():New()
#xcommand MENUITEM [ <oMenuItem> PROMPT ] <cPrompt> ;
[ IDENT <nIdent> ] [ ACTION <uAction,...> ] ;
[ CHECKED <bChecked> ] => ;
[ <oMenuItem> := ] HBDbMenu():AddItem( HBDbMenuItem():New( <cPrompt>,;
[{||<uAction>}], [<bChecked>], [<nIdent>] ) )
#xcommand SEPARATOR => HBDbMenu():AddItem( HBDbMenuItem():New( "-" ) )
#xcommand ENDMENU => ATail( HBDbMenu():aMenus ):Build()
PROCEDURE Main
LOCAL oMenu
SETMODE( 25,80 )
SET CURSOR OFF
SET COLOR TO "W/B"
CLEAR SCREEN
oMenu = __dbgBuildMenu()
oMenu:Display()
oMenu:ShowPopup( 1 )
while oMenu:nOpenPopup != 0
oMenu:ProcessKey( Inkey( 0 ) )
end
RETURN
// EOP: Main
FUNCTION __dbgBuildMenu() // Builds the debugger pulldown menu
LOCAL oMenu
MENU oMenu
MENUITEM " ~File "
MENU
MENUITEM " ~Open..." ACTION ALERT( "open" )
MENUITEM " ~Resume" ACTION ALERT( "open" )
MENUITEM " O~S Shell" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " e~Xit Alt-X " ACTION oMenu:Close()
ENDMENU
MENUITEM " ~Locate "
MENU
MENUITEM " ~Find" ACTION ALERT( "open" )
MENUITEM " ~Next" ACTION ALERT( "open" )
MENUITEM " ~Previous" ACTION ALERT( "open" )
MENUITEM " ~Goto line..." ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~Case sensitive " IDENT "CASE" ;
ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~View "
MENU
MENUITEM " ~Sets" ACTION ALERT( "open" )
MENUITEM " ~WorkAreas F6" ACTION ALERT( "open" )
MENUITEM " ~App Screen F4 " ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~CallStack" IDENT "CALLSTACK" ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Run "
MENU
MENUITEM " ~Animate" IDENT "ANIMATE" ACTION ALERT( "open" )
MENUITEM " ~Step F8" ACTION ALERT( "open" )
MENUITEM " ~Trace F10" ACTION ALERT( "open" )
MENUITEM " ~Go F5" ACTION ALERT( "open" )
MENUITEM " to ~Cursor F7" ACTION ALERT( "open" )
MENUITEM " ~Next routine Ctrl-F5" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " s~Peed..." ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Point "
MENU
MENUITEM " ~Watchpoint..." ACTION ALERT( "open" )
MENUITEM " ~Tracepoint..." ACTION ALERT( "open" )
MENUITEM " ~Breakpoint F9 " ACTION ALERT( "open" )
MENUITEM " ~Delete..." ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Monitor "
MENU
MENUITEM " ~Public" IDENT "PUBLIC" ACTION ALERT( "open" )
MENUITEM " pri~Vate " IDENT "PRIVATE" ACTION ALERT( "open" )
MENUITEM " ~Static" IDENT "STATIC" ACTION ALERT( "open" )
MENUITEM " ~Local" IDENT "LOCAL" ACTION ALERT( "open" )
MENUITEM " ~Global" IDENT "GLOBAL" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~All" IDENT "ALL" ACTION ALERT( "open" )
MENUITEM " S~how all Globals" IDENT "SHOWALLGLOBALS" ACTION ALERT( "open" )
MENUITEM " s~Ort" ACTION Alert( "open" )
ENDMENU
MENUITEM " ~Options "
MENU
MENUITEM " ~Preprocessed Code" IDENT "PPO" ACTION ALERT( "open" )
MENUITEM " ~Line Numbers" IDENT "LINE" ACTION ALERT( "open" )
MENUITEM " ~Exchange Screens" ACTION ALERT( "open" )
MENUITEM " swap on ~Input" ACTION ALERT( "open" )
MENUITEM " code~Block Trace" IDENT "CODEBLOCK" ACTION ALERT( "open" )
MENUITEM " ~Menu Bar" ACTION ALERT( "open" )
MENUITEM " mono ~Display" IDENT "MONO" ACTION ALERT( "open" )
MENUITEM " ~Colors..." ACTION ALERT( "open" )
MENUITEM " ~Tab Width..." ACTION ALERT( "open" )
MENUITEM " path for ~Files..." ACTION ALERT( "open" )
MENUITEM " R~un at startup" IDENT "ALTD" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~Save Settings..." ACTION ALERT( "open" )
MENUITEM " ~Restore Settings... " ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Window "
MENU
MENUITEM " ~Next Tab " ACTION ALERT( "open" )
MENUITEM " ~Prev Sh-Tab" ACTION ALERT( "open" )
MENUITEM " ~Move" ACTION ALERT( "open" )
MENUITEM " ~Size" ACTION ALERT( "open" )
MENUITEM " ~Zoom F2" ACTION ALERT( "open" )
MENUITEM " ~Iconize" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~Tile" ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Help "
MENU
MENUITEM " ~About Help " ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~Keys" ACTION ALERT( "open" )
MENUITEM " ~Windows" ACTION ALERT( "open" )
MENUITEM " ~Menus" ACTION ALERT( "open" )
MENUITEM " ~Commands" ACTION ALERT( "open" )
ENDMENU
ENDMENU
RETURN oMenu
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
#include "hbclass.ch"
#include "hbmemvar.ch"
#include "box.ch"
#include "inkey.ch"
#include "setcurs.ch"
CREATE CLASS HBDbMenu
METHOD aMenus SETGET
VAR nTop
VAR nLeft
VAR nBottom
VAR nRight
VAR aItems
VAR cClrHilite
VAR cClrHotKey
VAR cClrHotFocus
VAR cClrPopup
VAR nOpenPopup // zero if no popup is shown
VAR lPopup
VAR cBackImage
METHOD New()
METHOD AddItem( oMenuItem )
METHOD Build()
METHOD ClosePopup( nPopup )
METHOD CLOSE() INLINE ::ClosePopup( ::nOpenPopup ), ::nOpenPopup := 0
METHOD DeHilite()
METHOD DISPLAY()
METHOD EvalAction()
METHOD GetHotKeyPos( cKey )
METHOD GetItemByIdent( uIdent )
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 LoadColors() // Load current debugger colors settings
METHOD ProcessKey( nKey )
METHOD Refresh() // Repaints the top bar
METHOD ShowPopup( nPopup )
ENDCLASS
METHOD aMenus( xNewVal ) CLASS HBDbMenu
STATIC t_aMenus
IF PCount() > 0
t_aMenus := xNewVal
ENDIF
RETURN t_aMenus
METHOD New() CLASS HBDbMenu
IF ::aMenus == NIL
::aMenus := {}
::lPopup := .F.
ELSE
::lPopup := .T.
ENDIF
::nTop := 0
::nLeft := 0
::nBottom := 0
::nRight := 0
::aItems := {}
::LoadColors()
::nOpenPopup := 0
AAdd( ::aMenus, Self )
RETURN Self
METHOD AddItem( oMenuItem ) CLASS HBDbMenu
LOCAL oLastMenu := ATail( ::aMenus )
LOCAL 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 HBDbMenu
LOCAL nPos := 0
LOCAL oMenuItem, n
IF Len( ::aMenus ) == 1 // pulldown menu
FOR EACH oMenuItem IN ::aItems
oMenuItem:nRow := 0
oMenuItem:nCol := nPos
nPos += Len( StrTran( oMenuItem: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 + 1
::nBottom := ::nTop + Len( ::aItems ) + 1
FOR EACH oMenuItem IN ::aItems
IF ! hb_LeftEq( oMenuItem:cPrompt, "-" )
oMenuItem:cPrompt := " " + PadR( oMenuItem:cPrompt, ::nRight - ::nLeft - 1 )
ENDIF
NEXT
ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems ):bAction := ATail( ::aMenus )
::aMenus := ASize( ::aMenus, Len( ::aMenus ) - 1 )
ENDIF
RETURN nil
METHOD ClosePopup( nPopup ) CLASS HBDbMenu
LOCAL oPopup
IF nPopup != 0
oPopup := ::aItems[ nPopup ]:bAction
IF HB_ISOBJECT( oPopup )
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 HBDbMenu
LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
RETURN nil
METHOD Display() CLASS HBDbMenu
LOCAL oMenuItem
IF ::lPopup
::cBackImage := SaveScreen( ::nTop, ::nLeft, ::nBottom + 1, ::nRight + 2 )
DispBox( ::nTop, ::nLeft, ::nBottom, ::nRight, HB_B_SINGLE_UNI, ::cClrPopup )
hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight )
ELSE
hb_Scroll( 0, 0, 0, MaxCol(),,, ::cClrPopup )
ENDIF
FOR EACH oMenuItem IN ::aItems
IF oMenuItem:cPrompt == "-" // Separator
@ oMenuItem:nRow, ::nLeft + 1 SAY ;
Replicate( "-", ::nRight - ::nLeft - 1 ) COLOR ::cClrPopup
ELSE
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
ENDIF
NEXT
RETURN nil
METHOD EvalAction() CLASS HBDbMenu
LOCAL oPopup := ::aItems[ ::nOpenPopup ]:bAction
LOCAL oMenuItem := oPopup:aItems[ oPopup:nOpenPopup ]
IF oMenuItem:bAction != NIL
::Close()
Eval( oMenuItem:bAction, oMenuItem )
ENDIF
RETURN nil
METHOD GetHotKeyPos( cKey ) CLASS HBDbMenu
LOCAL oMenuItem
FOR EACH oMenuItem IN ::aItems
IF Upper( SubStr( oMenuItem:cPrompt, ;
At( "~", oMenuItem:cPrompt ) + 1, 1 ) ) == cKey
RETURN oMenuItem:__enumIndex()
ENDIF
NEXT
RETURN 0
METHOD GetItemOrdByCoors( nRow, nCol ) CLASS HBDbMenu
LOCAL oMenuItem
FOR EACH oMenuItem IN ::aItems
IF oMenuItem:nRow == nRow .AND. nCol >= oMenuItem:nCol .AND. ;
nCol <= oMenuItem:nCol + Len( oMenuItem:cPrompt ) - 2
RETURN oMenuItem:__enumIndex()
ENDIF
NEXT
RETURN 0
METHOD GetItemByIdent( uIdent ) CLASS HBDbMenu
LOCAL oMenuItem
LOCAL oItem
FOR EACH oMenuItem IN ::aItems
IF HB_ISOBJECT( oMenuItem:bAction )
IF ( oItem := oMenuItem:bAction:GetItemByIdent( uIdent ) ) != NIL
RETURN oItem
ENDIF
ELSEIF ValType( oMenuItem:Ident ) == ValType( uIdent ) .AND. ;
oMenuItem:Ident == uIdent
RETURN oMenuItem
ENDIF
NEXT
RETURN NIL
METHOD GoBottom() CLASS HBDbMenu
LOCAL oPopup
IF ::IsOpen()
oPopup := ::aItems[ ::nOpenPopup ]:bAction
oPopup:DeHilite()
oPopup:ShowPopup( Len( oPopup:aItems ) )
ENDIF
RETURN nil
METHOD GoLeft() CLASS HBDbMenu
LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]
IF ::nOpenPopup != 0
IF ::lPopup
oMenuItem:Display( ::cClrPopup, ::CClrHotKey )
ELSE
::ClosePopup( ::nOpenPopup )
ENDIF
IF ::nOpenPopup > 1
--::nOpenPopup
DO WHILE ::nOpenPopup > 1 .AND. ;
hb_LeftEq( ::aItems[ ::nOpenPopup ]:cPrompt, "-" )
--::nOpenPopup
ENDDO
::ShowPopup( ::nOpenPopup )
ELSE
::ShowPopup( ::nOpenPopup := Len( ::aItems ) )
ENDIF
ENDIF
RETURN nil
METHOD GoRight() CLASS HBDbMenu
LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]
IF ::nOpenPopup != 0
IF ::lPopup
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
ELSE
::ClosePopup( ::nOpenPopup )
ENDIF
IF ::nOpenPopup < Len( ::aItems )
++::nOpenPopup
DO WHILE ::nOpenPopup < Len( ::aItems ) .AND. ;
hb_LeftEq( ::aItems[ ::nOpenPopup ]:cPrompt, "-" )
++::nOpenPopup
ENDDO
::ShowPopup( ::nOpenPopup )
ELSE
::ShowPopup( ::nOpenPopup := 1 )
ENDIF
ENDIF
RETURN nil
METHOD GoTop() CLASS HBDbMenu
LOCAL oPopup
IF ::IsOpen()
oPopup := ::aItems[ ::nOpenPopup ]:bAction
oPopup:DeHilite()
oPopup:ShowPopup( 1 )
ENDIF
RETURN nil
METHOD LoadColors() CLASS HBDbMenu
LOCAL aColors := { "W+/B", "BG+/R", "GR+/B", "GR+/R", "N+/BG", "GR+/B", ;
"BR+/B", "W/G", "R+/B", "BG+/N", "BG/N" }
LOCAL oMenuItem
::cClrPopup := aColors[ 8 ]
::cClrHotKey := aColors[ 9 ]
::cClrHilite := aColors[ 10 ]
::cClrHotFocus := aColors[ 11 ]
FOR EACH oMenuItem IN ::aItems
IF HB_ISOBJECT( oMenuItem:bAction )
oMenuItem:bAction:LoadColors()
ENDIF
NEXT
RETURN nil
METHOD Refresh() CLASS HBDbMenu
LOCAL oMenuItem
DispBegin()
IF ! ::lPopup
hb_Scroll( 0, 0, 0, MaxCol(),,, ::cClrPopup )
ENDIF
FOR EACH oMenuItem IN ::aItems
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
NEXT
DispEnd()
RETURN nil
METHOD ShowPopup( nPopup ) CLASS HBDbMenu
::aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus )
::nOpenPopup := nPopup
IF HB_ISOBJECT( ::aItems[ nPopup ]:bAction )
::aItems[ nPopup ]:bAction:Display()
::aItems[ nPopup ]:bAction:ShowPopup( 1 )
ENDIF
RETURN nil
METHOD ProcessKey( nKey ) CLASS HBDbMenu
LOCAL nPopup
LOCAL oPopup
do case
CASE nKey == K_LBUTTONDOWN
IF MRow() == 0
IF ( nPopup := ::GetItemOrdByCoors( 0, MCol() ) ) != 0
IF nPopup != ::nOpenPopup
::ClosePopup( ::nOpenPopup )
::ShowPopup( nPopup )
ENDIF
ENDIF
ELSE
oPopup := ::aItems[ ::nOpenPopup ]:bAction
IF ( nPopup := oPopup:GetItemOrdByCoors( MRow(), MCol() ) ) == 0
::Close()
ELSE
oPopup:DeHilite()
oPopup:nOpenPopup := nPopup
oPopup:aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus )
::EvalAction()
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 ::nOpenPopup > 0
IF IsAlpha( hb_keyChar( nKey ) )
oPopup := ::aItems[ ::nOpenPopup ]:bAction
IF ( nPopup := oPopup:GetHotKeyPos( Upper( hb_keyChar( nKey ) ) ) ) > 0
IF oPopup:nOpenPopup != nPopup
oPopup:DeHilite()
oPopup:ShowPopup( nPopup )
ENDIF
::EvalAction()
ENDIF
ENDIF
ELSEIF ( nPopup := ::GetHotKeyPos( __dbgAltToKey( nKey ) ) ) != ::nOpenPopup
::Close()
::ShowPopup( nPopup )
ENDIF
END
RETURN nil
FUNCTION __dbgAltToKey( 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, K_ALT_1, K_ALT_2, K_ALT_3, K_ALT_4, ;
K_ALT_5, K_ALT_6, K_ALT_7, K_ALT_8, K_ALT_9, K_ALT_0 }, nKey )
RETURN iif( nIndex > 0, SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890", nIndex, 1 ), "" )
function HB_LEFTEQ( c1, c2 ) ; return Left( c1, Len( c2 ) ) == c2
// function HB_DISPOUTATBOX() ; return nil
function HB_UTF8TOSTRBOX() ; return nil
function HB_KEYCHAR() ; return nil
#pragma -b-
#xcommand MENU [<oMenu>] => [ <oMenu> := ] HBDbMenu():New()
#xcommand MENUITEM [ <oMenuItem> PROMPT ] <cPrompt> ;
[ IDENT <nIdent> ] [ ACTION <uAction,...> ] ;
[ CHECKED <bChecked> ] => ;
[ <oMenuItem> := ] HBDbMenu():AddItem( HBDbMenuItem():New( <cPrompt>,;
[{||<uAction>}], [<bChecked>], [<nIdent>] ) )
#xcommand SEPARATOR => HBDbMenu():AddItem( HBDbMenuItem():New( "-" ) )
#xcommand ENDMENU => ATail( HBDbMenu():aMenus ):Build()
static lExit := .F.
PROCEDURE Main
LOCAL oMenu, nOldPopup, nMenuItem
SETMODE( 25,80 )
SET CURSOR OFF
SET COLOR TO "W/B"
CLEAR SCREEN
oMenu = __dbgBuildMenu()
oMenu:Display()
oMenu:ShowPopup( 1 )
while ! lExit
nOldPopup = oMenu:nOpenPopup
nMenuItem = oMenu:aItems[ nOldPopup ]:bAction:nOpenPopup
oMenu:ProcessKey( Inkey( 0 ) )
if oMenu:nOpenPopup == 0
oMenu:ShowPopup( nOldPopup, nMenuItem )
endif
end
RETURN
// EOP: Main
FUNCTION __dbgBuildMenu() // Builds the debugger pulldown menu
LOCAL oMenu
MENU oMenu
MENUITEM " ~File "
MENU
MENUITEM " ~Open..." ACTION ALERT( "open" )
MENUITEM " ~Resume" ACTION ALERT( "open" )
MENUITEM " O~S Shell" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " e~Xit Alt-X " ACTION lExit := .T.
ENDMENU
MENUITEM " ~Locate "
MENU
MENUITEM " ~Find" ACTION ALERT( "open" )
MENUITEM " ~Next" ACTION ALERT( "open" )
MENUITEM " ~Previous" ACTION ALERT( "open" )
MENUITEM " ~Goto line..." ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~Case sensitive " IDENT "CASE" ;
ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~View "
MENU
MENUITEM " ~Sets" ACTION ALERT( "open" )
MENUITEM " ~WorkAreas F6" ACTION ALERT( "open" )
MENUITEM " ~App Screen F4 " ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~CallStack" IDENT "CALLSTACK" ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Run "
MENU
MENUITEM " ~Animate" IDENT "ANIMATE" ACTION ALERT( "open" )
MENUITEM " ~Step F8" ACTION ALERT( "open" )
MENUITEM " ~Trace F10" ACTION ALERT( "open" )
MENUITEM " ~Go F5" ACTION ALERT( "open" )
MENUITEM " to ~Cursor F7" ACTION ALERT( "open" )
MENUITEM " ~Next routine Ctrl-F5" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " s~Peed..." ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Point "
MENU
MENUITEM " ~Watchpoint..." ACTION ALERT( "open" )
MENUITEM " ~Tracepoint..." ACTION ALERT( "open" )
MENUITEM " ~Breakpoint F9 " ACTION ALERT( "open" )
MENUITEM " ~Delete..." ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Monitor "
MENU
MENUITEM " ~Public" IDENT "PUBLIC" ACTION ALERT( "open" )
MENUITEM " pri~Vate " IDENT "PRIVATE" ACTION ALERT( "open" )
MENUITEM " ~Static" IDENT "STATIC" ACTION ALERT( "open" )
MENUITEM " ~Local" IDENT "LOCAL" ACTION ALERT( "open" )
MENUITEM " ~Global" IDENT "GLOBAL" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~All" IDENT "ALL" ACTION ALERT( "open" )
MENUITEM " S~how all Globals" IDENT "SHOWALLGLOBALS" ACTION ALERT( "open" )
MENUITEM " s~Ort" ACTION Alert( "open" )
ENDMENU
MENUITEM " ~Options "
MENU
MENUITEM " ~Preprocessed Code" IDENT "PPO" ACTION ALERT( "open" )
MENUITEM " ~Line Numbers" IDENT "LINE" ACTION ALERT( "open" )
MENUITEM " ~Exchange Screens" ACTION ALERT( "open" )
MENUITEM " swap on ~Input" ACTION ALERT( "open" )
MENUITEM " code~Block Trace" IDENT "CODEBLOCK" ACTION ALERT( "open" )
MENUITEM " ~Menu Bar" ACTION ALERT( "open" )
MENUITEM " mono ~Display" IDENT "MONO" ACTION ALERT( "open" )
MENUITEM " ~Colors..." ACTION ALERT( "open" )
MENUITEM " ~Tab Width..." ACTION ALERT( "open" )
MENUITEM " path for ~Files..." ACTION ALERT( "open" )
MENUITEM " R~un at startup" IDENT "ALTD" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~Save Settings..." ACTION ALERT( "open" )
MENUITEM " ~Restore Settings... " ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Window "
MENU
MENUITEM " ~Next Tab " ACTION ALERT( "open" )
MENUITEM " ~Prev Sh-Tab" ACTION ALERT( "open" )
MENUITEM " ~Move" ACTION ALERT( "open" )
MENUITEM " ~Size" ACTION ALERT( "open" )
MENUITEM " ~Zoom F2" ACTION ALERT( "open" )
MENUITEM " ~Iconize" ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~Tile" ACTION ALERT( "open" )
ENDMENU
MENUITEM " ~Help "
MENU
MENUITEM " ~About Help " ACTION ALERT( "open" )
SEPARATOR
MENUITEM " ~Keys" ACTION ALERT( "open" )
MENUITEM " ~Windows" ACTION ALERT( "open" )
MENUITEM " ~Menus" ACTION ALERT( "open" )
MENUITEM " ~Commands" ACTION ALERT( "open" )
ENDMENU
ENDMENU
RETURN oMenu
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
#include "hbclass.ch"
#include "hbmemvar.ch"
#include "box.ch"
#include "inkey.ch"
#include "setcurs.ch"
CREATE CLASS HBDbMenu
METHOD aMenus SETGET
VAR nTop
VAR nLeft
VAR nBottom
VAR nRight
VAR aItems
VAR cClrHilite
VAR cClrHotKey
VAR cClrHotFocus
VAR cClrPopup
VAR nOpenPopup // zero if no popup is shown
VAR lPopup
VAR cBackImage
METHOD New()
METHOD AddItem( oMenuItem )
METHOD Build()
METHOD ClosePopup( nPopup )
METHOD CLOSE() INLINE ::ClosePopup( ::nOpenPopup ), ::nOpenPopup := 0
METHOD DeHilite()
METHOD DISPLAY()
METHOD EvalAction()
METHOD GetHotKeyPos( cKey )
METHOD GetItemByIdent( uIdent )
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 LoadColors() // Load current debugger colors settings
METHOD ProcessKey( nKey )
METHOD Refresh() // Repaints the top bar
METHOD ShowPopup( nPopup )
ENDCLASS
METHOD aMenus( xNewVal ) CLASS HBDbMenu
STATIC t_aMenus
IF PCount() > 0
t_aMenus := xNewVal
ENDIF
RETURN t_aMenus
METHOD New() CLASS HBDbMenu
IF ::aMenus == NIL
::aMenus := {}
::lPopup := .F.
ELSE
::lPopup := .T.
ENDIF
::nTop := 0
::nLeft := 0
::nBottom := 0
::nRight := 0
::aItems := {}
::LoadColors()
::nOpenPopup := 0
AAdd( ::aMenus, Self )
RETURN Self
METHOD AddItem( oMenuItem ) CLASS HBDbMenu
LOCAL oLastMenu := ATail( ::aMenus )
LOCAL 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 HBDbMenu
LOCAL nPos := 0
LOCAL oMenuItem, n
IF Len( ::aMenus ) == 1 // pulldown menu
FOR EACH oMenuItem IN ::aItems
oMenuItem:nRow := 0
oMenuItem:nCol := nPos
nPos += Len( StrTran( oMenuItem: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 + 1
::nBottom := ::nTop + Len( ::aItems ) + 1
FOR EACH oMenuItem IN ::aItems
IF ! hb_LeftEq( oMenuItem:cPrompt, "-" )
oMenuItem:cPrompt := " " + PadR( oMenuItem:cPrompt, ::nRight - ::nLeft - 1 )
ENDIF
NEXT
ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems ):bAction := ATail( ::aMenus )
::aMenus := ASize( ::aMenus, Len( ::aMenus ) - 1 )
ENDIF
RETURN nil
METHOD ClosePopup( nPopup ) CLASS HBDbMenu
LOCAL oPopup
IF nPopup != 0
oPopup := ::aItems[ nPopup ]:bAction
IF HB_ISOBJECT( oPopup )
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 HBDbMenu
LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
RETURN nil
METHOD Display() CLASS HBDbMenu
LOCAL oMenuItem
IF ::lPopup
::cBackImage := SaveScreen( ::nTop, ::nLeft, ::nBottom + 1, ::nRight + 2 )
DispBox( ::nTop, ::nLeft, ::nBottom, ::nRight, HB_B_SINGLE_UNI, ::cClrPopup )
hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight )
ELSE
hb_Scroll( 0, 0, 0, MaxCol(),,, ::cClrPopup )
ENDIF
FOR EACH oMenuItem IN ::aItems
IF oMenuItem:cPrompt == "-" // Separator
@ oMenuItem:nRow, ::nLeft + 1 SAY ;
Replicate( "-", ::nRight - ::nLeft - 1 ) COLOR ::cClrPopup
ELSE
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
ENDIF
NEXT
RETURN nil
METHOD EvalAction() CLASS HBDbMenu
LOCAL oPopup := ::aItems[ ::nOpenPopup ]:bAction
LOCAL oMenuItem := oPopup:aItems[ oPopup:nOpenPopup ]
IF oMenuItem:bAction != NIL
::Close()
Eval( oMenuItem:bAction, oMenuItem )
ENDIF
RETURN nil
METHOD GetHotKeyPos( cKey ) CLASS HBDbMenu
LOCAL oMenuItem
FOR EACH oMenuItem IN ::aItems
IF Upper( SubStr( oMenuItem:cPrompt, ;
At( "~", oMenuItem:cPrompt ) + 1, 1 ) ) == cKey
RETURN oMenuItem:__enumIndex()
ENDIF
NEXT
RETURN 0
METHOD GetItemOrdByCoors( nRow, nCol ) CLASS HBDbMenu
LOCAL oMenuItem
FOR EACH oMenuItem IN ::aItems
IF oMenuItem:nRow == nRow .AND. nCol >= oMenuItem:nCol .AND. ;
nCol <= oMenuItem:nCol + Len( oMenuItem:cPrompt ) - 2
RETURN oMenuItem:__enumIndex()
ENDIF
NEXT
RETURN 0
METHOD GetItemByIdent( uIdent ) CLASS HBDbMenu
LOCAL oMenuItem
LOCAL oItem
FOR EACH oMenuItem IN ::aItems
IF HB_ISOBJECT( oMenuItem:bAction )
IF ( oItem := oMenuItem:bAction:GetItemByIdent( uIdent ) ) != NIL
RETURN oItem
ENDIF
ELSEIF ValType( oMenuItem:Ident ) == ValType( uIdent ) .AND. ;
oMenuItem:Ident == uIdent
RETURN oMenuItem
ENDIF
NEXT
RETURN NIL
METHOD GoBottom() CLASS HBDbMenu
LOCAL oPopup
IF ::IsOpen()
oPopup := ::aItems[ ::nOpenPopup ]:bAction
oPopup:DeHilite()
oPopup:ShowPopup( Len( oPopup:aItems ) )
ENDIF
RETURN nil
METHOD GoLeft() CLASS HBDbMenu
LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]
IF ::nOpenPopup != 0
IF ::lPopup
oMenuItem:Display( ::cClrPopup, ::CClrHotKey )
ELSE
::ClosePopup( ::nOpenPopup )
ENDIF
IF ::nOpenPopup > 1
--::nOpenPopup
DO WHILE ::nOpenPopup > 1 .AND. ;
hb_LeftEq( ::aItems[ ::nOpenPopup ]:cPrompt, "-" )
--::nOpenPopup
ENDDO
::ShowPopup( ::nOpenPopup )
ELSE
::ShowPopup( ::nOpenPopup := Len( ::aItems ) )
ENDIF
ENDIF
RETURN nil
METHOD GoRight() CLASS HBDbMenu
LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]
IF ::nOpenPopup != 0
IF ::lPopup
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
ELSE
::ClosePopup( ::nOpenPopup )
ENDIF
IF ::nOpenPopup < Len( ::aItems )
++::nOpenPopup
DO WHILE ::nOpenPopup < Len( ::aItems ) .AND. ;
hb_LeftEq( ::aItems[ ::nOpenPopup ]:cPrompt, "-" )
++::nOpenPopup
ENDDO
::ShowPopup( ::nOpenPopup )
ELSE
::ShowPopup( ::nOpenPopup := 1 )
ENDIF
ENDIF
RETURN nil
METHOD GoTop() CLASS HBDbMenu
LOCAL oPopup
IF ::IsOpen()
oPopup := ::aItems[ ::nOpenPopup ]:bAction
oPopup:DeHilite()
oPopup:ShowPopup( 1 )
ENDIF
RETURN nil
METHOD LoadColors() CLASS HBDbMenu
LOCAL aColors := { "W+/B", "BG+/R", "GR+/B", "GR+/R", "N+/BG", "GR+/B", ;
"BR+/B", "W/G", "R+/B", "BG+/N", "BG/N" }
LOCAL oMenuItem
::cClrPopup := aColors[ 8 ]
::cClrHotKey := aColors[ 9 ]
::cClrHilite := aColors[ 10 ]
::cClrHotFocus := aColors[ 11 ]
FOR EACH oMenuItem IN ::aItems
IF HB_ISOBJECT( oMenuItem:bAction )
oMenuItem:bAction:LoadColors()
ENDIF
NEXT
RETURN nil
METHOD Refresh() CLASS HBDbMenu
LOCAL oMenuItem
DispBegin()
IF ! ::lPopup
hb_Scroll( 0, 0, 0, MaxCol(),,, ::cClrPopup )
ENDIF
FOR EACH oMenuItem IN ::aItems
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
NEXT
DispEnd()
RETURN nil
METHOD ShowPopup( nPopup, nMenuItem ) CLASS HBDbMenu
::aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus )
::nOpenPopup := nPopup
IF HB_ISOBJECT( ::aItems[ nPopup ]:bAction )
::aItems[ nPopup ]:bAction:Display()
::aItems[ nPopup ]:bAction:ShowPopup( If( nMenuItem == nil, 1, nMenuItem ) )
ENDIF
RETURN nil
METHOD ProcessKey( nKey ) CLASS HBDbMenu
LOCAL nPopup
LOCAL oPopup
do case
CASE nKey == K_LBUTTONDOWN
IF MRow() == 0
IF ( nPopup := ::GetItemOrdByCoors( 0, MCol() ) ) != 0
IF nPopup != ::nOpenPopup
::ClosePopup( ::nOpenPopup )
::ShowPopup( nPopup )
ENDIF
ENDIF
ELSE
oPopup := ::aItems[ ::nOpenPopup ]:bAction
IF ( nPopup := oPopup:GetItemOrdByCoors( MRow(), MCol() ) ) == 0
::Close()
ELSE
oPopup:DeHilite()
oPopup:nOpenPopup := nPopup
oPopup:aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus )
::EvalAction()
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 ::nOpenPopup > 0
IF IsAlpha( hb_keyChar( nKey ) )
oPopup := ::aItems[ ::nOpenPopup ]:bAction
IF ( nPopup := oPopup:GetHotKeyPos( Upper( hb_keyChar( nKey ) ) ) ) > 0
IF oPopup:nOpenPopup != nPopup
oPopup:DeHilite()
oPopup:ShowPopup( nPopup )
ENDIF
::EvalAction()
ENDIF
ENDIF
ELSEIF ( nPopup := ::GetHotKeyPos( __dbgAltToKey( nKey ) ) ) != ::nOpenPopup
::Close()
::ShowPopup( nPopup )
ENDIF
END
RETURN nil
FUNCTION __dbgAltToKey( 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, K_ALT_1, K_ALT_2, K_ALT_3, K_ALT_4, ;
K_ALT_5, K_ALT_6, K_ALT_7, K_ALT_8, K_ALT_9, K_ALT_0 }, nKey )
RETURN iif( nIndex > 0, SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890", nIndex, 1 ), "" )
function HB_LEFTEQ( c1, c2 ) ; return Left( c1, Len( c2 ) ) == c2
// function HB_DISPOUTATBOX() ; return nil
function HB_UTF8TOSTRBOX() ; return nil
function HB_KEYCHAR() ; return nil
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 31 guests