home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR503.W96 / MENUSYS.PR_ / MENUSYS.PR
Encoding:
Text File  |  1995-06-20  |  15.9 KB  |  569 lines
  1. /*──────────────────────────────────────────────────────────────────────────*/
  2. /*
  3.    CA-Clipper 5.3 menu item class definition
  4.    February, 1994
  5.  
  6. */
  7.  
  8. /*──────────────────────────────────────────────────────────────────────────*/
  9. // include files
  10.  
  11. #include "button.ch"
  12. #include "setcurs.ch"
  13. #include "llibg.ch"
  14. #include "inkey.ch"
  15.  
  16. /*──────────────────────────────────────────────────────────────────────────*/
  17. /* static variable declarations. */
  18.  
  19. static aMenuList, nMenuLevel, oMenu
  20. static OldMessage:= NIL
  21. static OldMsgPos := 0
  22.  
  23. /*──────────────────────────────────────────────────────────────────────────*/
  24. function MenuModal( oTopBar, nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor )
  25.    local nKey, nOldItem, nNewItem, lSaveCursor, lLeftDown, oOldMenu, ;
  26.          oNewMenu, nOldLevel, nNewLevel, lMsgFlag, cOldMsg, nMsgWidth, ;
  27.          oMenuItem, nMenuItem, nReturn, nCol, nRow, nTemp, bKeyBlock
  28.  
  29.    nReturn := 0
  30.    nCol:=COL()
  31.    nRow:=ROW()
  32.    lSaveCursor := SetCursor( SC_NONE )
  33.  
  34.    if     ( ! ValType( nMsgRow ) == "N" )
  35.       lMsgFlag := .f.
  36.  
  37.    elseif ( ! ValType( nMsgLeft ) == "N" )
  38.       lMsgFlag := .f.
  39.  
  40.    elseif ( ! ValType( nMsgRight ) == "N" )
  41.       lMsgFlag := .f.
  42.  
  43.    else
  44.       lMsgFlag := .t.
  45.       cOldMsg := SaveScreen( nMsgRow, nMsgLeft, nMsgRow, nMsgRight )
  46.       nMsgWidth := nMsgRight - nMsgLeft + 1
  47.    endif
  48.  
  49.    while ( nSelection == 0 )
  50.       nKey := Inkey( 0 )
  51.  
  52.       if ( nKey == K_LBUTTONDOWN )
  53.          nSelection := oTopBar:HitTest( MRow(), MCol() )
  54.  
  55.       elseif ( ( nSelection := oTopBar:GetAccel( nKey ) ) != 0 )
  56.  
  57.       elseif ( IsShortCut( oTopBar, nKey, @nReturn ) )
  58.          return ( nReturn )                                      /* NOTE! */
  59.  
  60.       endif
  61.    enddo
  62.  
  63.    if ( ! oTopBar:GetItem( nSelection ):Enabled )
  64.       return ( 0 )                                               /* NOTE! */
  65.    endif
  66.  
  67.    oMenu := oTopBar
  68.  
  69.    aMenuList  := Array( 16 )
  70.    nMenuLevel := 1
  71.  
  72.    aMenuList[ 1 ] := oMenu
  73.  
  74.    lLeftDown := mLeftDown()
  75.  
  76.    oMenu:Select( nSelection )
  77.    oMenu:Display()
  78.    PushMenu( .t. )
  79.    ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .t. )
  80.  
  81.    while (.T.)
  82.       nKey := INKEY( 0 )
  83.  
  84.       // Check for SET KEY first
  85.       if !( ( bKeyBlock := setkey( nKey ) ) == NIL )
  86.          eval( bKeyBlock, procname(1), procline(1), "" )
  87.          loop
  88.       endif
  89.  
  90.       if ( nKey == K_MOUSEMOVE )
  91. //====== mouse movement.
  92.  
  93.          if ( lLeftDown )
  94.  
  95.             if ( ! HitTest( @oNewMenu, @nNewLevel, @nNewItem ) )
  96. //------------ hit nowhere.
  97.             elseif ( nMenuLevel != nNewLevel )
  98. //------------ menu level change.
  99.  
  100.                if ( nNewItem == oNewMenu:Current )
  101.                elseif ( oNewMenu:GetItem( nNewItem ):Enabled )
  102.                   oMenu := oNewMenu
  103.                   PopChild( nNewLevel )
  104.                   oMenu:Select( nNewItem )
  105.                   oMenu:Display()
  106.                   PushMenu()
  107.                   ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .t. )
  108.                endif
  109.  
  110.             elseif ( nNewItem != oNewMenu:Current() )
  111. //------------ menu item change.
  112.  
  113.                PopChild( nMenuLevel )
  114.  
  115.                if ( oMenu:GetItem( nNewItem ):Enabled )
  116.                   oMenu:Select( nNewItem )
  117.                   oMenu:Display()
  118.                   PushMenu()
  119.                   ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .t. )
  120.                endif
  121.  
  122.             endif
  123.  
  124.          endif
  125.  
  126.       elseif ( nKey == K_DOWN )
  127. //====== down arrow key.
  128.  
  129.          if ( nMenuLevel > 1 )
  130.             nTemp = oMenu:GetNext()
  131.             if (nTemp == 0 )
  132.               nTemp = oMenu:GetFirst()
  133.             endif
  134.             oMenu:Select( nTemp )
  135.             oMenu:Display()
  136.             ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .t. )
  137.  
  138.          endif
  139.  
  140.       elseif ( nKey == K_UP )
  141. //====== up arrow key.
  142.  
  143.          if ( nMenuLevel > 1 )
  144.             nTemp = oMenu:GetPrev()
  145.             if (nTemp == 0 )
  146.               nTemp = oMenu:GetLast()
  147.             endif
  148.             oMenu:Select( nTemp )
  149.             oMenu:Display()
  150.             ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .t. )
  151.  
  152.          endif
  153.  
  154.       elseif ( nKey == K_LEFT )
  155. //====== left arrow key.
  156.  
  157.          if ( nMenuLevel > 1 )
  158.             PopMenu()
  159.          endif
  160.  
  161.          if ( nMenuLevel == 1 )
  162.             nTemp = oMenu:GetPrev()
  163.             if (nTemp == 0 )
  164.               nTemp = oMenu:GetLast()
  165.             endif
  166.             oMenu:Select( nTemp )
  167.             oMenu:Display()
  168.             PushMenu( .t. )
  169.          endif
  170.          ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .t. )
  171.  
  172.       elseif ( nKey == K_RIGHT )
  173. //====== right arrow key.
  174.  
  175.          if ( ! PushMenu( .t. ) )
  176.             PopAll()
  177.             nTemp = oMenu:GetNext()
  178.             if (nTemp == 0 )
  179.               nTemp = oMenu:GetFirst()
  180.             endif
  181.             oMenu:Select( nTemp )
  182.             oMenu:Display()
  183.             PushMenu( .t. )
  184.          endif
  185.          ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .t. )
  186.  
  187.       elseif ( nKey == K_ENTER )
  188. //====== enter key .
  189.  
  190.          if ( PushMenu( .t. ) )
  191.             ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .t. )
  192.  
  193.          else
  194.             ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .f. )
  195.             nReturn := Execute()
  196.             exit
  197.  
  198.          endif
  199.  
  200.       elseif ( nKey == K_ESC )
  201. //====== escape key - go to previous menu
  202.  
  203.          PopMenu()
  204.          oMenu:Display()
  205.          ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .t. )
  206.  
  207.       elseif ( nKey == K_LBUTTONDOWN )
  208. //====== mouse left button press.
  209.  
  210.          if ( ! HitTest( @oNewMenu, @nNewLevel, @nNewItem ) )
  211.          elseif ( nNewLevel == nMenuLevel )
  212.  
  213.             oMenu:Select( nNewItem )
  214.             oMenu:Display()
  215.             if ( ! PushMenu() )
  216.                oMenu:Display()
  217.             endif
  218.             PushMenu()
  219.             ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .t. )
  220.  
  221.          else
  222.             nMenuLevel := nNewLevel
  223.             oMenu      := aMenuList[ nMenuLevel ]
  224.  
  225.             nMenuItem :=  oMenu:Current
  226.             oMenuItem := oMenu:GetItem( nMenuItem )
  227.             if ( ( oMenuItem := oMenu:GetItem( oMenu:Current ) ):IsPopUp() )
  228.                oMenuItem:Data:Close()
  229.             endif
  230.  
  231.             if ( nMenuItem != nNewItem )
  232.                nMenuItem := nNewItem
  233.                oMenu:Select( nNewItem )
  234.                oMenu:Display()
  235.                PushMenu()
  236.             endif
  237.  
  238.             ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .t. )
  239.  
  240.          endif
  241.  
  242.          lLeftDown := .t.
  243.  
  244.       elseif ( nKey == K_LBUTTONUP )
  245. //====== mouse left button release.
  246.  
  247.          lLeftDown := .f.
  248.  
  249.          if ( ! HitTest( @oNewMenu, @nNewLevel, @nNewItem ) )
  250.          elseif ( nNewLevel == nMenuLevel )
  251.             ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .f. )
  252.             nReturn := Execute()
  253.             if ( nReturn <> 0 )
  254.               exit
  255.             endif
  256.  
  257.          else
  258.             nNewItem := oMenu:GetFirst()
  259.             if ( nNewItem == 0 )
  260.             else
  261.                oMenu:Select(  nNewItem )
  262.                oMenu:Display()
  263.                ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .t. )
  264.             endif
  265.  
  266.          endif
  267.  
  268.       elseif ( ( nNewItem := oMenu:GetAccel( nKey ) ) != 0 )
  269. //=== check for menu item accelerator key.
  270.  
  271.          oMenu:Select( nNewItem )
  272.          oMenu:Display()
  273.  
  274.          if ( ! PushMenu( .t. ) )
  275.             ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .f. )
  276.             nReturn := Execute()
  277.             exit
  278.          endif
  279.          ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .t. )
  280.  
  281.       elseif ( IsShortCut( oTopBar, nKey, @nReturn ) )
  282.          exit
  283.  
  284.      elseif ( ( nNewItem := oTopBar:GetAccel( nKey ) ) != 0 )
  285. //=== check for topbar accelerator key
  286.  
  287.          PopAll()
  288.          oMenu:Select( nNewItem )
  289.          oMenu:Display()
  290.          if ( oTopBar:GetItem( nNewItem ):IsPopUp() )
  291.             PushMenu( .t. )
  292.          else
  293.             ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .f. )
  294.             nReturn := Execute()
  295.             exit
  296.          endif
  297.          ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, .t. )
  298.  
  299.       endif
  300.    enddo
  301.  
  302.    IF ( lMsgFlag .and. !_ISGRAPHIC() )
  303.       RestScreen( nMsgRow, nMsgLeft, nMsgRow, nMsgRight, cOldMsg )
  304.    ENDIF
  305.  
  306.    PopAll()
  307.  
  308.    oMenu:Select( 0 )
  309.    oTopBar:Display()
  310.    setpos(nRow,nCol)
  311.    SetCursor( lSaveCursor )
  312.  
  313.    return ( nReturn )
  314.  
  315.  
  316.  
  317. /*──────────────────────────────────────────────────────────────────────────*/
  318. static function PushMenu( lSelect )
  319.    local oNewMenu
  320.  
  321.       oNewMenu := oMenu:GetItem( oMenu:Current )
  322.  
  323.       if ( oNewMenu == NIL )
  324.       elseif ( oNewMenu:IsPopUp )
  325.  
  326.          if ( ! ValType( lSelect ) == "L" )
  327.             lSelect := .f.
  328.          endif
  329.  
  330.          oMenu := oNewMenu:Data
  331.          aMenuList[ ++nMenuLevel ] := oMenu
  332.  
  333.          if ( lSelect )
  334.             oMenu:Select( oMenu:GetFirst() )
  335.  
  336.          else
  337.             oMenu:Select( 0 )
  338.  
  339.          endif
  340.  
  341.          oMenu:Open()
  342.  
  343.          return ( .t. )                                         /* NOTE ! */
  344.       endif
  345.  
  346.  
  347.    return ( .f. )
  348.  
  349.  
  350. /*──────────────────────────────────────────────────────────────────────────*/
  351. static function PopMenu()
  352.  
  353.       if ( nMenuLevel > 1 )
  354.          oMenu:Close()
  355.          oMenu := aMenuList[ --nMenuLevel ]
  356.  
  357.          return ( .t. )                                         /* NOTE ! */
  358.       endif
  359.  
  360.  
  361.    return ( .f. )
  362.  
  363.  
  364. /*──────────────────────────────────────────────────────────────────────────*/
  365. static function PopChild( nNewLevel )
  366.    local oOldMenu, nCurrent
  367.  
  368.       if ( ( nCurrent := oMenu:Current ) != 0 )
  369.          oOldMenu := oMenu:GetItem( nCurrent )
  370.  
  371.          if ( oOldMenu:IsPopUp )
  372.             oOldMenu:Data:Close()
  373.             nMenuLevel := nNewLevel
  374.  
  375.             return ( .t. )                                      /* NOTE ! */
  376.          endif
  377.       endif
  378.  
  379.  
  380.    return ( .f. )
  381.  
  382.  
  383. /*──────────────────────────────────────────────────────────────────────────*/
  384. static function PopAll()
  385.  
  386.       if ( nMenuLevel > 1 )
  387.          aMenuList[ 2 ]:Close()
  388.          nMenuLevel := 1
  389.          oMenu := aMenuList[ 1 ]
  390.       endif
  391.  
  392.    return ( .t. )
  393.  
  394.  
  395. /*──────────────────────────────────────────────────────────────────────────*/
  396. static function Execute()
  397.    local oNewMenu, nCurrent, lPas
  398.       lPas :=.T.
  399.       oNewMenu := oMenu:GetItem( oMenu:Current )
  400.  
  401.       if ( oNewMenu == NIL )
  402.       elseif ( ! oNewMenu:IsPopUp )
  403.          if (oMenu:classname()== "POPUPMENU")
  404.              oMenu:Close()
  405.              Eval( oNewMenu:Data, oNewMenu )
  406.              lPas:=.F.
  407.          elseif (oMenu:classname() == "TOPBARMENU" )
  408.              Eval( oNewMenu:Data, oNewMenu )
  409.              lPas:=.F.
  410.          endif
  411.          PopAll()
  412.          nCurrent:=oMenu:Current
  413.          oMenu:Select( 0 )
  414.          oMenu:Display()
  415.          oMenu:Select(nCurrent)
  416.          if lPas
  417.            oMenu:Close()
  418.            Eval( oNewMenu:Data, oNewMenu )
  419.          endif
  420.          oMenu:Select(0)
  421.          return ( oNewMenu:Id )                                 /* NOTE ! */
  422.  
  423.       endif
  424.  
  425.    return ( 0 )
  426.  
  427.  
  428. /*──────────────────────────────────────────────────────────────────────────*/
  429. static function HitTest( oNewMenu, nNewLevel, nNewItem )
  430.  
  431.       for nNewLevel := nMenuLevel to 1 step -1
  432.          oNewMenu := aMenuList[ nNewLevel ]
  433.          nNewItem := oNewMenu:HitTest( mRow(), mCol() )
  434.  
  435.          if ( nNewItem < 0 )
  436.              return ( .f. )                                        /* NOTE ! */
  437.          elseif ( nNewItem >0)
  438.             return ( .t. )                                      /* NOTE ! */
  439.          endif
  440.  
  441.       next
  442.  
  443.    return ( .f. )
  444.  
  445.  
  446. /*──────────────────────────────────────────────────────────────────────────*/
  447. static function ShowMsg( lMsgFlag, nMsgRow, nMsgLeft, nMsgWidth, cMsgColor, lMode )
  448.    local cOldColor, nCurrent, lColor, nForeColor, nBackColor, cMsg:=NIL,;
  449.          nAt, nMsgPos, mOldState, nFontRow
  450.  
  451.       if ( lMsgFlag )
  452.          if ( lColor := ValType( cMsgColor ) == "C" )
  453.             cOldColor := SetColor( cMsgColor )
  454.          endif
  455.  
  456.          if (! _ISGRAPHIC() )
  457.             SetPos( nMsgRow, nMsgLeft )
  458.  
  459.             if ( ( nCurrent := oMenu:Current ) == 0 )
  460.                DevOut( Space( nMsgWidth ) )
  461.  
  462.             elseif ( lMode )
  463.                DevOut( PadC( oMenu:GetItem( nCurrent ):Message, nMsgWidth ) )
  464.  
  465.             else
  466.                DevOut( Space( nMsgWidth ) )
  467.  
  468.             endif
  469.          else
  470.  
  471.             mOldState := MSETCURSOR(.F.)
  472.  
  473.             nForeColor := _GETNUMCOLOR ( cMsgColor )
  474.             nAt := AT( "/" , cMsgColor )
  475.             nBackColor := _GETNUMCOLOR( Substr( cMsgColor, nAt + 1, len( cMsgColor ) - nAt) )
  476.  
  477.             nCurrent := oMenu:Current
  478.  
  479.             if (nCurrent == 0)
  480.                if ( ValType( OldMessage ) == "N" )
  481.                   cMsg := SPACE( LEN( OldMessage ) )
  482.                else
  483.                   cMsg := SPACE( 0 )
  484.                endif
  485.             else
  486.                cMsg := oMenu:GetItem( nCurrent ):Message
  487.             endif
  488.  
  489.             nMsgPos := int(nMsgWidth / 2) - int(len(cMsg) / 2) + 1
  490.  
  491.             nFontRow = gMode()[LLG_MODE_FONT_ROW]
  492.  
  493.             if (OldMessage <> NIL)
  494.                if ( (OldMessage <> cMsg ) .or. (len(cMsg) == 0) )
  495.                   gWriteAt( OldMsgPos * 8,;
  496.                             nMsgRow * nFontRow,;
  497.                             OldMessage,;
  498.                             nBackColor,;
  499.                             LLG_MODE_SET )
  500.                   gFrame(nMsgLeft * 8,;
  501.                         (nMsgRow * nFontRow) - 1,;
  502.                         (nMsgLeft + nMsgWidth) * 8,;
  503.                        ((nMsgRow + 1) * nFontRow) + 1,;
  504.                          nBackColor,;
  505.                          8, 15,;
  506.                          2, 2, 2, 2, LLG_MODE_XOR, LLG_FILL )
  507.                endif
  508.             endif
  509.  
  510.             if ( (OldMessage <> cMsg) .or. (len(cMsg) == 0) )
  511.                gFrame(nMsgLeft * 8,;
  512.                      (nMsgRow * nFontRow) - 1,;
  513.                      (nMsgLeft + nMsgWidth) * 8,;
  514.                     ((nMsgRow + 1) * nFontRow) + 1,;
  515.                       nBackColor,;
  516.                       8, 15,;
  517.                       2, 2, 2, 2, LLG_MODE_XOR, LLG_FILL )
  518.                gWriteAt( nMsgPos * 8,;
  519.                          nMsgRow * nFontRow,;
  520.                          cMsg,;
  521.                          nForeColor,;
  522.                          LLG_MODE_SET )
  523.             endif
  524.  
  525.             OldMessage := cMsg
  526.             OldMsgPos := nMsgPos
  527.  
  528.             MSETCURSOR(mOldState)
  529.  
  530.          endif
  531.  
  532.          if ( lColor )
  533.             SetColor( cOldColor )
  534.          endif
  535.  
  536.          return ( .t. )                                         /* NOTE ! */
  537.       endif
  538.  
  539.    return ( .f. )
  540.  
  541.  
  542. /*──────────────────────────────────────────────────────────────────────────*/
  543. function IsShortCut( oMenu, nKey, nID )
  544.    LOCAL nItem, nTotal, nShortCut, oItem, bData
  545.  
  546.       IF ( ( nShortCut := oMenu:GetShortCt( nKey ) ) == 0 )
  547.          nTotal := oMenu:ItemCount()
  548.          FOR nItem := 1 TO nTotal
  549.             IF ( ! ( oItem := oMenu:GetItem( nItem ) ):IsPopUp() )
  550.             ELSEIF ( IsShortCut( oItem:Data, nKey, @nID ) )
  551.                RETURN ( .T. )
  552.             ENDIF
  553.          NEXT
  554.  
  555.       ELSEIF ( ! ( oItem := oMenu:GetItem( nShortCut ) ):IsPopUp() )
  556.          oMenu:select( nShortCut )
  557.          Eval( oItem:Data, oItem )
  558.          nID := oItem:ID
  559.          RETURN ( .T. )                                          /* NOTE! */
  560.  
  561.       ENDIF
  562.  
  563.    RETURN ( .F. )
  564.  
  565.  
  566. /*──────────────────────────────────────────────────────────────────────────*/
  567. /*──────────────────────────────────────────────────────────────────────────*/
  568. 
  569.