FiveTech Software tech support forums

by **Antonio Linares** » Fri Apr 10, 2015 6:47 am

Gustavo,

Please comment this line:

// function HB_LEFTEQ() ; return nil

by **HunterEC** » Sat Apr 11, 2015 8:15 am

Antonio:

Now is giving me a compiler error (that function is used 3 times in dbgtmenu.prg):

Code: Select all Expand view: 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 !

by **Antonio Linares** » Sat Apr 11, 2015 8:20 am

Are you using xHarbour ?

by **Antonio Linares** » Sat Apr 11, 2015 8:23 am

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

by **HunterEC** » Sat Apr 11, 2015 9:26 am

Antonio:

Now it runs but, how do I activate the menu ? Thank you.

by **Antonio Linares** » Sat Apr 11, 2015 10:43 am

Gustavo,

Please try:

oMenu:ShowPopup( 1 )

by **HunterEC** » Sat Apr 11, 2015 7:33 pm

Antonio:

The saga continues, hehehe. Another runtime error:

Code: Select all Expand view: ┌───────────────────────────────────────────────────────────┐ │ Error BASE/1004 Class: 'NIL' has no exported method: │ │ SHOWPOPUP Arguments: ( [ 1] = Type: U [ 2] = Type: N Val: │ │ 1) │ │ │ │ Quit │ └───────────────────────────────────────────────────────────┘

by **Antonio Linares** » Sat Apr 11, 2015 8:34 pm

Gustavo,

Could you post a complete example to test it here ? many thanks

by **Antonio Linares** » Sat Apr 11, 2015 8:58 pm

Gustavo,

Here you a have a complete working example :-)

Code: Select all Expand view: #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

by **Antonio Linares** » Sat Apr 11, 2015 9:17 pm

Painting lines (separators are not totally ok):

Code: Select all Expand view: #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

by **Antonio Linares** » Sat Apr 11, 2015 10:00 pm

This version remains in a loop until exit is selected and returns to the fired menuitem:

Code: Select all Expand view: #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

by **HunterEC** » Sun Apr 12, 2015 7:46 am

Antonio:

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 ?

by **Antonio Linares** » Sun Apr 12, 2015 2:44 pm

Gustavo,

Please change this line:

IF ( nPopup := oPopup:GetHotKeyPos( Upper( hb_keyChar( nKey ) ) ) ) > 0

like this:

IF ( nPopup := oPopup:GetHotKeyPos( Upper( Chr( nKey ) ) ) ) > 0

by **HunterEC** » Sun Apr 12, 2015 6:49 pm

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 !

by **Antonio Linares** » Sun Apr 12, 2015 10:58 pm

Gustavo,

Highlighted letters are working fine here with Harbour.

Can you use Harbour ?

FiveTech Software tech support forums

To Antonio:

Re: To Antonio:

Re: To Antonio:

Re: To Antonio:

Re: To Antonio:

Re: To Antonio:

Re: To Antonio:

Re: To Antonio:

Re: To Antonio:

Re: To Antonio:

Re: To Antonio:

Re: To Antonio:

Re: To Antonio:

Re: To Antonio:

Re: To Antonio:

Re: To Antonio:

Who is online