Gustavo,
Please comment this line:
// function HB_LEFTEQ() ; return nil
Board index FiveWin for Harbour/xHarbour To Antonio:
Antonio:
Now is giving me a compiler error (that function is used 3 times in dbgtmenu.prg):
Thank you very much for your help !
Now is giving me a compiler error (that function is used 3 times in dbgtmenu.prg):
xLINK: error: Unresolved external symbol '_HB_FUN_HB_LEFTEQ referenced from (dbgtmenu.obj)'.
xLINK: fatal error: 1 unresolved external(s).Thank you very much for your help !
Are you using xHarbour ?
If so, please use this function:
function hb_LeftEq( c1, c2 )
return SubStr( c1, 1, Len( c2 ) ) == c2
or
function hb_LeftEq( c1, c2 )
return Left( c1, Len( c2 ) ) == c2
Antonio:
Now it runs but, how do I activate the menu ? Thank you.
Gustavo,
Please try:
oMenu:ShowPopup( 1 )
Antonio:
The saga continues, hehehe. Another runtime error:
The saga continues, hehehe. Another runtime error:
┌───────────────────────────────────────────────────────────┐
│ Error BASE/1004 Class: 'NIL' has no exported method: │
│ SHOWPOPUP Arguments: ( [ 1] = Type: U [ 2] = Type: N Val: │
│ 1) │
│ │
│ Quit │
└───────────────────────────────────────────────────────────┘Gustavo,
Could you post a complete example to test it here ? many thanks
Gustavo,
Here you a have a complete working example
Here you a have a complete working example
#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 nilPainting lines (separators are not totally ok):
#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 nilThis version remains in a loop until exit is selected and returns to the fired menuitem:
#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 nilAntonio:
Thank you very much ! Working perfectly. This will allow me to finish this app's last text update and star migrating it to GUI. Reports are already migrated. Is there a way to implement accelerator keys ?
Gustavo,
Please change this line:
IF ( nPopup := oPopup:GetHotKeyPos( Upper( hb_keyChar( nKey ) ) ) ) > 0
like this:
IF ( nPopup := oPopup:GetHotKeyPos( Upper( Chr( nKey ) ) ) ) > 0
Antonio:
Did it, but doesn't work. For example Alt-X doesn't do anything. The highlighted letter on every option on the pull down menus, doesn't work either. You have to highlight the option with the arrow keys and press ENTER to select it. Any ideas ? Thank you very much !
Gustavo,
Highlighted letters are working fine here with Harbour.
Can you use Harbour ?