To Antonio:

To Antonio:

Postby HunterEC » Wed Apr 08, 2015 3:03 am

Antonio:

This post is related to this older one:

Code: Select all  Expand view
http://forums.fivetechsupport.com/viewtopic.php?f=3&t=30429


I had compiled the program you suggested and also this one
Code: Select all  Expand view
dbgtmenu.prg
.

I cannot make this last one to compile. I'm going nuts, hehehe, but I need urgently to implement this console menu. Can you take a look and tell me what it is wrong ? I'm compiling with xBuilder to then move forward and buildx it. The error I'm getting is:
Code: Select all  Expand view
Line 60 Error E0030 Syntax error: "syntax error at 'STATIC'"


Thank you very much !!!

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()

FUNCTION __dbgBuildMenu( oDebugger ) // Builds the debugger pulldown menu

   LOCAL oMenu

   MENU oMenu
      MENUITEM " ~File "
      MENU
         MENUITEM " ~Open..."          ACTION oDebugger:Open()
         MENUITEM " ~Resume"           ACTION oDebugger:Resume()
         MENUITEM " O~S Shell"         ACTION oDebugger:OSShell()
         SEPARATOR
         MENUITEM " e~Xit Alt-X "      ACTION oDebugger:Quit()
      ENDMENU

      MENUITEM " ~Locate "
      MENU
         MENUITEM " ~Find"             ACTION oDebugger:Locate()
         MENUITEM " ~Next"             ACTION oDebugger:FindNext()
         MENUITEM " ~Previous"         ACTION oDebugger:FindPrevious()
         MENUITEM " ~Goto line..."     ACTION oDebugger:SearchLine()
         SEPARATOR
         MENUITEM " ~Case sensitive "  IDENT "CASE" ;
            ACTION oDebugger:ToggleCaseSensitive() ;
            CHECKED oDebugger:lCaseSensitive
      ENDMENU

      MENUITEM " ~View "
      MENU
         MENUITEM " ~Sets" ACTION oDebugger:ViewSets()
         MENUITEM " ~WorkAreas   F6"   ACTION oDebugger:ShowWorkAreas()
         MENUITEM " ~App Screen  F4 "  ACTION oDebugger:ShowAppScreen()
         SEPARATOR
         MENUITEM " ~CallStack" IDENT "CALLSTACK";
            ACTION oDebugger:Stack() ;
            CHECKED oDebugger:lShowCallStack
      ENDMENU

   MENUITEM " ~Run "
   MENU
      MENUITEM " ~Animate" IDENT "ANIMATE" ;
         ACTION ( oDebugger:ToggleAnimate(), oDebugger:Animate() ) ;
         CHECKED oDebugger:lAnimate
      MENUITEM " ~Step              F8" ACTION oDebugger:Step()
      MENUITEM " ~Trace            F10" ACTION oDebugger:Trace()
      MENUITEM " ~Go                F5" ACTION oDebugger:Go()
      MENUITEM " to ~Cursor         F7" ACTION oDebugger:ToCursor()
      MENUITEM " ~Next routine Ctrl-F5" ACTION oDebugger:NextRoutine()
      SEPARATOR
      MENUITEM " s~Peed..."             ACTION oDebugger:Speed()
   ENDMENU

   MENUITEM " ~Point "
   MENU
      MENUITEM " ~Watchpoint..."        ACTION oDebugger:WatchPointAdd()
      MENUITEM " ~Tracepoint..."        ACTION oDebugger:TracePointAdd()
      MENUITEM " ~Breakpoint F9 "       ACTION oDebugger:ToggleBreakPoint()
      MENUITEM " ~Delete..."            ACTION oDebugger:WatchPointDel()
   ENDMENU

   MENUITEM " ~Monitor "
   MENU
      MENUITEM " ~Public"   IDENT "PUBLIC" ;
         ACTION oDebugger:Public() ;
         CHECKED oDebugger:lShowPublics

      MENUITEM " pri~Vate " IDENT "PRIVATE" ;
         ACTION oDebugger:Private() ;
         CHECKED oDebugger:lShowPrivates

      MENUITEM " ~Static"   IDENT "STATIC" ;
         ACTION oDebugger:Static() ;
         CHECKED oDebugger:lShowStatics

      MENUITEM " ~Local"    IDENT "LOCAL" ;
         ACTION oDebugger:Local() ;
         CHECKED oDebugger:lShowLocals

      MENUITEM " ~Global"   IDENT "GLOBAL" ;
         ACTION oDebugger:Global() ;
         CHECKED oDebugger:lShowGlobals

         SEPARATOR

      MENUITEM " ~All"      IDENT "ALL" ;
         ACTION oDebugger:All() ;
         CHECKED oDebugger:lAll

      MENUITEM " S~how all Globals" IDENT "SHOWALLGLOBALS" ;
         ACTION oDebugger:ShowAllGlobals() ;
         CHECKED oDebugger:lShowAllGlobals

      MENUITEM " s~Ort" ACTION oDebugger:Sort()
   ENDMENU

   MENUITEM " ~Options "
   MENU
      MENUITEM " ~Preprocessed Code" IDENT "PPO" ;
         ACTION oDebugger:OpenPPO() ;
         CHECKED oDebugger:lPPO
      MENUITEM " ~Line Numbers" IDENT "LINE" ;
         ACTION oDebugger:LineNumbers() ;
         CHECKED oDebugger:lLineNumbers
      MENUITEM " ~Exchange Screens"     ACTION oDebugger:NotSupported()
      MENUITEM " swap on ~Input"        ACTION oDebugger:NotSupported()
      MENUITEM " code~Block Trace" IDENT "CODEBLOCK" ;
         ACTION oDebugger:CodeblockTrace() ;
         CHECKED oDebugger:lCBTrace
      MENUITEM " ~Menu Bar"             ACTION oDebugger:NotSupported()
      MENUITEM " mono ~Display" IDENT "MONO";
         ACTION oDebugger:MonoDisplay() ;
         CHECKED oDebugger:lMonoDisplay
      MENUITEM " ~Colors..."            ACTION oDebugger:Colors()
      MENUITEM " ~Tab Width..."         ACTION oDebugger:TabWidth()
      MENUITEM " path for ~Files..."    ACTION oDebugger:PathForFiles()
      MENUITEM " R~un at startup" IDENT "ALTD" ;
         ACTION oDebugger:RunAtStartup() ;
         CHECKED oDebugger:lRunAtStartup
      SEPARATOR
      MENUITEM " ~Save Settings..."     ACTION oDebugger:SaveSettings()
      MENUITEM " ~Restore Settings... " ACTION oDebugger:RestoreSettings()
   ENDMENU

   MENUITEM " ~Window "
   MENU
      MENUITEM " ~Next Tab "            ACTION oDebugger:NextWindow()
      MENUITEM " ~Prev Sh-Tab"          ACTION oDebugger:PrevWindow()
      MENUITEM " ~Move"                 ACTION oDebugger:NotSupported()
      MENUITEM " ~Size"                 ACTION oDebugger:NotSupported()
      MENUITEM " ~Zoom F2"              ACTION oDebugger:NotSupported()
      MENUITEM " ~Iconize"              ACTION oDebugger:NotSupported()
      SEPARATOR
      MENUITEM " ~Tile"                 ACTION oDebugger:NotSupported()
   ENDMENU

   MENUITEM " ~Help "
   MENU
      MENUITEM " ~About Help "          ACTION oDebugger:ShowHelp()
      SEPARATOR
      MENUITEM " ~Keys"                 ACTION oDebugger:ShowHelp( "Keys" )
      MENUITEM " ~Windows"              ACTION oDebugger:ShowHelp( "Windows" )
      MENUITEM " ~Menus"                ACTION oDebugger:ShowHelp( "Menus" )
      MENUITEM " ~Commands"             ACTION oDebugger:ShowHelp( "Commands" )
   ENDMENU

ENDMENU

RETURN oMenu


Code: Select all  Expand view

/* NOTE: Don't use SAY/DevOut()/DevPos() for screen output, otherwise
the debugger output may interfere with the applications output
redirection, and is also slower. [vszakats] */


#pragma -b-

#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

   THREAD 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

   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 EACH oMenuItem IN ::aItems
         oMenuItem:nRow := ::nTop + oMenuItem:__enumIndex()
         oMenuItem:nCol := ::nLeft + 1
         nPos := Max( nPos, ::nLeft + Len( StrTran( oMenuItem: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

METHOD ClosePopup( nPopup ) CLASS HBDbMenu

   LOCAL oPopup

   IF nPopup != 0
      oPopup := ::aItems[ nPopup ]:bAction
      IF HB_ISOBJECT( oPopup )
         __dbgRestScreen( oPopup:nTop, oPopup:nLeft, ;
                          oPopup:nBottom + 1, oPopup:nRight + 2, ;
                          oPopup:cBackImage )
         oPopup:cBackImage := NIL
      ENDIF
      ::aItems[ nPopup ]:Display( ::cClrPopup, ::cClrHotKey )
   ENDIF

RETURN

METHOD DeHilite() CLASS HBDbMenu

   LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]

   oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
RETURN

METHOD Display() CLASS HBDbMenu

   LOCAL oMenuItem

   IF ::lPopup
      ::cBackImage := __dbgSaveScreen( ::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

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

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

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

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

METHOD GoTop() CLASS HBDbMenu

   LOCAL oPopup

   IF ::IsOpen()
      oPopup := ::aItems[ ::nOpenPopup ]:bAction
      oPopup:DeHilite()
      oPopup:ShowPopup( 1 )
   ENDIF

RETURN

METHOD LoadColors() CLASS HBDbMenu

   LOCAL aColors := __dbgColors()
   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

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

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

METHOD ProcessKey( nKey ) CLASS HBDbMenu

   LOCAL nPopup
   LOCAL oPopup

   SWITCH nKey
   CASE 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
      EXIT

   CASE K_ESC
      ::Close()
      EXIT

   CASE K_LEFT
      ::GoLeft()
      EXIT

   CASE K_RIGHT
      ::GoRight()
      EXIT

   CASE K_DOWN
      ::GoDown()
      EXIT

   CASE K_UP
      ::GoUp()
      EXIT

   CASE K_ENTER
      ::EvalAction()
      EXIT

   CASE K_HOME
      ::GoTop()
      EXIT

   CASE K_END
      ::GoBottom()
      EXIT

   DEFAULT

      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

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 ), "" )
HunterEC
 
Posts: 723
Joined: Tue Sep 04, 2007 8:45 am

Re: To Antonio:

Postby Antonio Linares » Wed Apr 08, 2015 7:29 am

Gustavo,

Please replace this line:

THREAD STATIC t_aMenus

with:

STATIC t_aMenus
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42063
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: To Antonio:

Postby HunterEC » Wed Apr 08, 2015 1:21 pm

Antonio:

Thank you very much ! It compiles but now it does not link. The errors are:
Code: Select all  Expand view
xLINK: error: Unresolved external symbol '_HB_FUN_HB_LEFTEQ referenced from (dbgtmenu.obj)'.
xLINK: error: Unresolved external symbol '_HB_FUN___DBGRESTSCREEN referenced from (dbgtmenu.obj)'.
xLINK: error: Unresolved external symbol '_HB_FUN___DBGSAVESCREEN referenced from (dbgtmenu.obj)'.
xLINK: error: Unresolved external symbol '_HB_FUN_HB_DISPOUTATBOX referenced from (dbgtmenu.obj)'.
xLINK: error: Unresolved external symbol '_HB_FUN_HB_UTF8TOSTRBOX referenced from (dbgtmenu.obj)'.
xLINK: error: Unresolved external symbol '_HB_FUN_HB_KEYCHAR referenced from (dbgtmenu.obj)'.
xLINK: fatal error: 6 unresolved external(s).



PD: Are we through with the Easy Report effort or do you still donations ? Reading the post yesterday makes me think we still need to cover the PayPal charges. I'm I correct ?
HunterEC
 
Posts: 723
Joined: Tue Sep 04, 2007 8:45 am

Re: To Antonio:

Postby Antonio Linares » Wed Apr 08, 2015 1:26 pm

Gustavo,

Please implement those functions are dummy ones:

function HB_LEFTEQ() ; return nil
function __DBGRESTSCREEN() ; return nil
function __DBGSAVESCREEN() ; return nil
function HB_DISPOUTATBOX() ; return nil
function HB_UTF8TOSTRBOX() ; return nil
function HB_KEYCHAR() ; return nil

and lets see how far you get :-)

Regarding Easy Report, its done. Many thanks :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42063
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: To Antonio:

Postby HunterEC » Wed Apr 08, 2015 4:51 pm

Antonio:

Thank you for your help.

Now I got a runtime error:
Code: Select all  Expand view
-------------------- Internal Error Handling Information  ---------------------

Subsystem Call ....: BASE
System Code .......: 1004
Default Status ....: .F.
Description .......: Class: 'NIL' has no exported method
Operation .........: GETCOLORS
Arguments .........:  [ 1] = Type: U
Involved File .....:
Dos Error Code ....: 0
Running threads ...: 1
VM thread ID ......: 1
OS thread ID ......: 2400

 Trace Through:
----------------
__DBGCOLORS           :   3,385 in Module: W:\xHarbour\source\debug\debugger.prg
__DBGCOLORS           :   3,385 in Module: W:\xHarbour\source\debug\debugger.prg
HBDBMENU:LOADCOLORS   :     315 in Module: dbgtmenu.prg
HBDBMENU:NEW          :      81 in Module: dbgtmenu.prg
__DBGBUILDMENU        :      25 in Module: FWMENU.PRG
MAIN                  :      16 in Module: FWMENU.PRG


############################## Video Screen Dump ##############################

+--------------------------------------------------------------------------------+
|                                                                                |
|Error BASE/1004  Class: 'NIL' has no exported method: GETCOLORS Arguments: ( [ 1|
|] = Type: U)                                                                    |
|                                                                                |
|Error at ...: __DBGCOLORS(3385) in Module: W:\xHarbour\source\debug\debugger.prg|
|                                                                                |
|Called from : __DBGCOLORS(3385) in Module: W:\xHarbour\source\debug\debugger.prg|
|                                                                                |
|Called from : HBDBMENU:LOADCOLORS(315) in Module: dbgtmenu.prg                  |
|Called from : HBDBMENU:NEW(81) in Module: dbgtmenu.prg                          |
|Called from : __DBGBUILDMENU(25) in Module: FWMENU.PRG                          |
|Called from : MAIN(16) in Module: FWMENU.PRG                                    |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
|                                                                                |
+--------------------------------------------------------------------------------+
 


Here's the latest source:
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 )
   __dbgBuildMenu( @oMenu )
RETURN
// EOP: Main


FUNCTION __dbgBuildMenu( oDebugger ) // Builds the debugger pulldown menu

   LOCAL oMenu

   MENU oMenu
      MENUITEM " ~File "
      MENU
         MENUITEM " ~Open..."          ACTION oDebugger:Open()
         MENUITEM " ~Resume"           ACTION oDebugger:Resume()
         MENUITEM " O~S Shell"         ACTION oDebugger:OSShell()
         SEPARATOR
         MENUITEM " e~Xit Alt-X "      ACTION oDebugger:Quit()
      ENDMENU

      MENUITEM " ~Locate "
      MENU
         MENUITEM " ~Find"             ACTION oDebugger:Locate()
         MENUITEM " ~Next"             ACTION oDebugger:FindNext()
         MENUITEM " ~Previous"         ACTION oDebugger:FindPrevious()
         MENUITEM " ~Goto line..."     ACTION oDebugger:SearchLine()
         SEPARATOR
         MENUITEM " ~Case sensitive "  IDENT "CASE" ;
            ACTION oDebugger:ToggleCaseSensitive() ;
            CHECKED oDebugger:lCaseSensitive
      ENDMENU

      MENUITEM " ~View "
      MENU
         MENUITEM " ~Sets" ACTION oDebugger:ViewSets()
         MENUITEM " ~WorkAreas   F6"   ACTION oDebugger:ShowWorkAreas()
         MENUITEM " ~App Screen  F4 "  ACTION oDebugger:ShowAppScreen()
         SEPARATOR
         MENUITEM " ~CallStack" IDENT "CALLSTACK";
            ACTION oDebugger:Stack() ;
            CHECKED oDebugger:lShowCallStack
      ENDMENU

   MENUITEM " ~Run "
   MENU
      MENUITEM " ~Animate" IDENT "ANIMATE" ;
         ACTION ( oDebugger:ToggleAnimate(), oDebugger:Animate() ) ;
         CHECKED oDebugger:lAnimate
      MENUITEM " ~Step              F8" ACTION oDebugger:Step()
      MENUITEM " ~Trace            F10" ACTION oDebugger:Trace()
      MENUITEM " ~Go                F5" ACTION oDebugger:Go()
      MENUITEM " to ~Cursor         F7" ACTION oDebugger:ToCursor()
      MENUITEM " ~Next routine Ctrl-F5" ACTION oDebugger:NextRoutine()
      SEPARATOR
      MENUITEM " s~Peed..."             ACTION oDebugger:Speed()
   ENDMENU

   MENUITEM " ~Point "
   MENU
      MENUITEM " ~Watchpoint..."        ACTION oDebugger:WatchPointAdd()
      MENUITEM " ~Tracepoint..."        ACTION oDebugger:TracePointAdd()
      MENUITEM " ~Breakpoint F9 "       ACTION oDebugger:ToggleBreakPoint()
      MENUITEM " ~Delete..."            ACTION oDebugger:WatchPointDel()
   ENDMENU

   MENUITEM " ~Monitor "
   MENU
      MENUITEM " ~Public"   IDENT "PUBLIC" ;
         ACTION oDebugger:Public() ;
         CHECKED oDebugger:lShowPublics

      MENUITEM " pri~Vate " IDENT "PRIVATE" ;
         ACTION oDebugger:Private() ;
         CHECKED oDebugger:lShowPrivates

      MENUITEM " ~Static"   IDENT "STATIC" ;
         ACTION oDebugger:Static() ;
         CHECKED oDebugger:lShowStatics

      MENUITEM " ~Local"    IDENT "LOCAL" ;
         ACTION oDebugger:Local() ;
         CHECKED oDebugger:lShowLocals

      MENUITEM " ~Global"   IDENT "GLOBAL" ;
         ACTION oDebugger:Global() ;
         CHECKED oDebugger:lShowGlobals

         SEPARATOR

      MENUITEM " ~All"      IDENT "ALL" ;
         ACTION oDebugger:All() ;
         CHECKED oDebugger:lAll

      MENUITEM " S~how all Globals" IDENT "SHOWALLGLOBALS" ;
         ACTION oDebugger:ShowAllGlobals() ;
         CHECKED oDebugger:lShowAllGlobals

      MENUITEM " s~Ort" ACTION oDebugger:Sort()
   ENDMENU

   MENUITEM " ~Options "
   MENU
      MENUITEM " ~Preprocessed Code" IDENT "PPO" ;
         ACTION oDebugger:OpenPPO() ;
         CHECKED oDebugger:lPPO
      MENUITEM " ~Line Numbers" IDENT "LINE" ;
         ACTION oDebugger:LineNumbers() ;
         CHECKED oDebugger:lLineNumbers
      MENUITEM " ~Exchange Screens"     ACTION oDebugger:NotSupported()
      MENUITEM " swap on ~Input"        ACTION oDebugger:NotSupported()
      MENUITEM " code~Block Trace" IDENT "CODEBLOCK" ;
         ACTION oDebugger:CodeblockTrace() ;
         CHECKED oDebugger:lCBTrace
      MENUITEM " ~Menu Bar"             ACTION oDebugger:NotSupported()
      MENUITEM " mono ~Display" IDENT "MONO";
         ACTION oDebugger:MonoDisplay() ;
         CHECKED oDebugger:lMonoDisplay
      MENUITEM " ~Colors..."            ACTION oDebugger:Colors()
      MENUITEM " ~Tab Width..."         ACTION oDebugger:TabWidth()
      MENUITEM " path for ~Files..."    ACTION oDebugger:PathForFiles()
      MENUITEM " R~un at startup" IDENT "ALTD" ;
         ACTION oDebugger:RunAtStartup() ;
         CHECKED oDebugger:lRunAtStartup
      SEPARATOR
      MENUITEM " ~Save Settings..."     ACTION oDebugger:SaveSettings()
      MENUITEM " ~Restore Settings... " ACTION oDebugger:RestoreSettings()
   ENDMENU

   MENUITEM " ~Window "
   MENU
      MENUITEM " ~Next Tab "            ACTION oDebugger:NextWindow()
      MENUITEM " ~Prev Sh-Tab"          ACTION oDebugger:PrevWindow()
      MENUITEM " ~Move"                 ACTION oDebugger:NotSupported()
      MENUITEM " ~Size"                 ACTION oDebugger:NotSupported()
      MENUITEM " ~Zoom F2"              ACTION oDebugger:NotSupported()
      MENUITEM " ~Iconize"              ACTION oDebugger:NotSupported()
      SEPARATOR
      MENUITEM " ~Tile"                 ACTION oDebugger:NotSupported()
   ENDMENU

   MENUITEM " ~Help "
   MENU
      MENUITEM " ~About Help "          ACTION oDebugger:ShowHelp()
      SEPARATOR
      MENUITEM " ~Keys"                 ACTION oDebugger:ShowHelp( "Keys" )
      MENUITEM " ~Windows"              ACTION oDebugger:ShowHelp( "Windows" )
      MENUITEM " ~Menus"                ACTION oDebugger:ShowHelp( "Menus" )
      MENUITEM " ~Commands"             ACTION oDebugger:ShowHelp( "Commands" )
   ENDMENU

ENDMENU

RETURN oMenu


I just want a workable console (text) menu, can we test this without the debugger code ? Thank you very much my friend !
HunterEC
 
Posts: 723
Joined: Tue Sep 04, 2007 8:45 am

Re: To Antonio:

Postby Antonio Linares » Wed Apr 08, 2015 4:56 pm

Gustavo,

Please replace all the ACTIONs with code like this:

MENUITEM " ~Open..." ACTION MsgInfo( "open" ) // oDebugger:Open()
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42063
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: To Antonio:

Postby HunterEC » Thu Apr 09, 2015 5:37 pm

Antonio:

My friend, what a nightmare trying to service a console app !!! :shock: :shock: I REALLY appreciate the help you'd given me on this issue.
I did replaced all actions with ALERT( "open" ) since MsgInfo is not available in console mode but ...
I'm getting another another runtime error:
Code: Select all  Expand view
Error BASE/1004  Class: 'NIL' has no exported method: GETCOLORS Arguments: ( [ 1
] = Type: U)

Error at ...: __DBGCOLORS(3385) in Module: W:\xHarbour\source\debug\debugger.prg

Called from : __DBGCOLORS(3385) in Module: W:\xHarbour\source\debug\debugger.prg

Called from : HBDBMENU:LOADCOLORS(315) in Module: dbgtmenu.prg
Called from : HBDBMENU:NEW(81) in Module: dbgtmenu.prg
Called from : __DBGBUILDMENU(25) in Module: FWMENU.PRG
Called from : MAIN(16) in Module: FWMENU.PRG


Here's the source for that second module:
Code: Select all  Expand view

/* NOTE: Don't use SAY/DevOut()/DevPos() for screen output, otherwise
the debugger output may interfere with the applications output
redirection, and is also slower. [vszakats] */


#pragma -b-

#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

   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 EACH oMenuItem IN ::aItems
         oMenuItem:nRow := ::nTop + oMenuItem:__enumIndex()
         oMenuItem:nCol := ::nLeft + 1
         nPos := Max( nPos, ::nLeft + Len( StrTran( oMenuItem: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

METHOD ClosePopup( nPopup ) CLASS HBDbMenu

   LOCAL oPopup

   IF nPopup != 0
      oPopup := ::aItems[ nPopup ]:bAction
      IF HB_ISOBJECT( oPopup )
         __dbgRestScreen( oPopup:nTop, oPopup:nLeft, ;
                          oPopup:nBottom + 1, oPopup:nRight + 2, ;
                          oPopup:cBackImage )
         oPopup:cBackImage := NIL
      ENDIF
      ::aItems[ nPopup ]:Display( ::cClrPopup, ::cClrHotKey )
   ENDIF

RETURN

METHOD DeHilite() CLASS HBDbMenu

   LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]

   oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
RETURN

METHOD Display() CLASS HBDbMenu

   LOCAL oMenuItem

   IF ::lPopup
      ::cBackImage := __dbgSaveScreen( ::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

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

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

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

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

METHOD GoTop() CLASS HBDbMenu

   LOCAL oPopup

   IF ::IsOpen()
      oPopup := ::aItems[ ::nOpenPopup ]:bAction
      oPopup:DeHilite()
      oPopup:ShowPopup( 1 )
   ENDIF

RETURN

METHOD LoadColors() CLASS HBDbMenu

   LOCAL aColors := __dbgColors()
   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

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

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

METHOD ProcessKey( nKey ) CLASS HBDbMenu

   LOCAL nPopup
   LOCAL oPopup

   SWITCH nKey
   CASE 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
      EXIT

   CASE K_ESC
      ::Close()
      EXIT

   CASE K_LEFT
      ::GoLeft()
      EXIT

   CASE K_RIGHT
      ::GoRight()
      EXIT

   CASE K_DOWN
      ::GoDown()
      EXIT

   CASE K_UP
      ::GoUp()
      EXIT

   CASE K_ENTER
      ::EvalAction()
      EXIT

   CASE K_HOME
      ::GoTop()
      EXIT

   CASE K_END
      ::GoBottom()
      EXIT

   DEFAULT

      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

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() ; return nil
function __DBGRESTSCREEN() ; return nil
function __DBGSAVESCREEN() ; return nil
function HB_DISPOUTATBOX() ; return nil
function HB_UTF8TOSTRBOX() ; return nil
function HB_KEYCHAR() ; return nil
HunterEC
 
Posts: 723
Joined: Tue Sep 04, 2007 8:45 am

Re: To Antonio:

Postby Antonio Linares » Thu Apr 09, 2015 7:51 pm

Gustavo,

You don't have to compile and link debugger.prg.

Just dbgmenu.prg and dbgtmenu.prg and your PRGs
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42063
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: To Antonio:

Postby Antonio Linares » Thu Apr 09, 2015 7:58 pm

Gustavo,

In this method please replace __dbgColors() with an array of the different colors to use

Code: Select all  Expand view
METHOD PROCEDURE LoadColors() CLASS HBDbMenu

   LOCAL aColors := __dbgColors()
   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
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42063
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: To Antonio:

Postby HunterEC » Thu Apr 09, 2015 8:59 pm

Antonio:

Where I can find dbgmenu.prg ? Thank you !!!!
HunterEC
 
Posts: 723
Joined: Tue Sep 04, 2007 8:45 am

Re: To Antonio:

Postby Antonio Linares » Thu Apr 09, 2015 9:26 pm

regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42063
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: To Antonio:

Postby HunterEC » Thu Apr 09, 2015 10:47 pm

Antonio:

Now I'm getting:
Code: Select all  Expand view

Subsystem Call ....: BASE
System Code .......: 1005
Default Status ....: .F.
Description .......: Message not found
Operation .........: HBDBMENUITEM:__ENUMINDEX
Arguments .........:
 


On this line:
Code: Select all  Expand view
        oMenuItem:nRow := ::nTop + oMenuItem:__enumIndex()
 
HunterEC
 
Posts: 723
Joined: Tue Sep 04, 2007 8:45 am

Re: To Antonio:

Postby Antonio Linares » Fri Apr 10, 2015 12:40 am

Gustavo,

Are you using Harbour or xHarbour ?
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42063
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: To Antonio:

Postby Antonio Linares » Fri Apr 10, 2015 12:45 am

Gustavo,

Please change this section of code in dbgtmenu.prg

Instead of:
Code: Select all  Expand view
     FOR EACH oMenuItem IN ::aItems
         oMenuItem:nRow := ::nTop + oMenuItem:__enumIndex()
         oMenuItem:nCol := ::nLeft + 1
         nPos := Max( nPos, ::nLeft + Len( StrTran( oMenuItem:cPrompt, "~" ) ) + 1 )
      NEXT


Use:
Code: Select all  Expand view
     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
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42063
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Re: To Antonio:

Postby HunterEC » Fri Apr 10, 2015 6:18 am

Antonio:

Now this ... (sorry to bother you so much, I know you got MORE IMPORTANT things to do)
Code: Select all  Expand view
Error BASE/1066  Argument error: conditional Arguments: ( [ 1] = Type: U)

Error at ...: HBDBMENU:BUILD(135) in Module: dbgtmenu.prg
Called from : __DBGBUILDMENU(33) in Module: FWMENU.PRG
Called from : MAIN(16) in Module: FWMENU.PRG


This is the code section:
Code: Select all  Expand view
     FOR EACH oMenuItem IN ::aItems
         IF ! hb_LeftEq( oMenuItem:cPrompt, "-" )
            oMenuItem:cPrompt := " " + PadR( oMenuItem:cPrompt, ::nRight - ::nLeft - 1 )
         ENDIF
      NEXT
 


Full source code follows:

FWMENU.PRG
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 )
   __dbgBuildMenu( @oMenu )
RETURN
// EOP: Main


FUNCTION __dbgBuildMenu( oDebugger ) // 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 ALERT( "open" )
      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 oDebugger:Sort()
   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


Source for dbgmenu.prg
Code: Select all  Expand view

/* NOTE: Don't use SAY/DevOut()/DevPos() for screen output, otherwise
the debugger output may interfere with the applications output
redirection, and is also slower. [vszakats] */


#pragma -b-

#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

   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

METHOD ClosePopup( nPopup ) CLASS HBDbMenu

   LOCAL oPopup

   IF nPopup != 0
      oPopup := ::aItems[ nPopup ]:bAction
      IF HB_ISOBJECT( oPopup )
         __dbgRestScreen( oPopup:nTop, oPopup:nLeft, ;
                          oPopup:nBottom + 1, oPopup:nRight + 2, ;
                          oPopup:cBackImage )
         oPopup:cBackImage := NIL
      ENDIF
      ::aItems[ nPopup ]:Display( ::cClrPopup, ::cClrHotKey )
   ENDIF

RETURN

METHOD DeHilite() CLASS HBDbMenu

   LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]

   oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
RETURN

METHOD Display() CLASS HBDbMenu

   LOCAL oMenuItem

   IF ::lPopup
      ::cBackImage := __dbgSaveScreen( ::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

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

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

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

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

METHOD GoTop() CLASS HBDbMenu

   LOCAL oPopup

   IF ::IsOpen()
      oPopup := ::aItems[ ::nOpenPopup ]:bAction
      oPopup:DeHilite()
      oPopup:ShowPopup( 1 )
   ENDIF

RETURN

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

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

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

METHOD ProcessKey( nKey ) CLASS HBDbMenu

   LOCAL nPopup
   LOCAL oPopup

   SWITCH nKey
   CASE 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
      EXIT

   CASE K_ESC
      ::Close()
      EXIT

   CASE K_LEFT
      ::GoLeft()
      EXIT

   CASE K_RIGHT
      ::GoRight()
      EXIT

   CASE K_DOWN
      ::GoDown()
      EXIT

   CASE K_UP
      ::GoUp()
      EXIT

   CASE K_ENTER
      ::EvalAction()
      EXIT

   CASE K_HOME
      ::GoTop()
      EXIT

   CASE K_END
      ::GoBottom()
      EXIT

   DEFAULT

      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

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() ; return nil
function __DBGRESTSCREEN() ; return nil
function __DBGSAVESCREEN() ; return nil
function HB_DISPOUTATBOX() ; return nil
function HB_UTF8TOSTRBOX() ; return nil
function HB_KEYCHAR() ; return nil
HunterEC
 
Posts: 723
Joined: Tue Sep 04, 2007 8:45 am

Next

Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot] and 64 guests