PC Toledo

Em homenagem a Paulo Cesar Toledo
https://pctoledo.org/

Problemas com prompt/menuto - harbour

https://pctoledo.org/viewtopic.php?t=12831

Página 2 de 2

Problemas com prompt/menuto - harbour

Enviado: 23 Mar 2012 01:20
por Abel
valeu, vou estudar estas rotinas de menu para ver se resolvo o problema de passar o mouse por cima..das
opcoes...e ele ir navegando..

Abel

Problemas com prompt/menuto - harbour

Enviado: 23 Mar 2012 08:22
por Pablo César
Abel, na minha opinião o problema no está no menuto e sim na biblioteca API que controla o mouse e alguma interferência que o SO faz sobre ela.

Problemas com prompt/menuto - harbour

Enviado: 23 Mar 2012 11:42
por Abel
Pablo, fiz uns testes e aparentemente qdo o menuto esta aguardando uma tecla, ele nao esta com o controle do mouse mrow() mcol() funcionando ele fica estatico esperando, coloquei um loop com inkey(0.1) e ele ja le o mrow() e mcol(), preciso adaptar algumas coisas ainda.

è possivel baixar o menuto.prg do xharbour para eu ver ?

Att
ABEL

Problemas com prompt/menuto - harbour

Enviado: 23 Mar 2012 11:50
por Pablo César
Ahhh é ? Quê bom que está conseguindo, não se esqueça de postar o seu exemplo, assim é de utilidade para todos. Eu procurei e encontrei este código de menuto.prg:

Código: Selecionar todos

/*
 * $Id: menuto.prg,v 1.15 2005/12/10 00:33:33 oh1 Exp $
 */

/*
 * Harbour Project source code:
 * PROMPT/MENU TO commands
 *
 * Released to Public Domain by Phil Barnett <philb@iag.net>
 * www - http://www.harbour-project.org
 *
 */

/* NOTE: Recursive use is supported. */

#include "color.ch"
#include "common.ch"
#include "inkey.ch"
#include "hbmemvar.ch"
#include "setcurs.ch"
#xtranslate COLORARRAY(<x>) => &( '{"' + strtran(<x>, ',', '","') + '"}' )

static s_aLevel   := {}
static s_nPointer := 1

function __AtPrompt( nRow, nCol, cPrompt, cMsg, cColor)

   if s_nPointer < 1
      s_nPointer := 1
   endif

   // add the current level empty array.
   do while len( s_aLevel ) < s_nPointer
      aadd( s_aLevel, {} )
   enddo

   // add to the static array
   aadd( s_aLevel[ s_nPointer ], { nRow, nCol, cPrompt, cMsg, cColor } )

   // put this prompt on the screen right now
   DispOutAt( nRow, nCol, cPrompt, cColor, .T. )

   return .f.

function __MenuTo( bBlock, cVariable )

   local nKey
   local y
   local q
   local n
   local lExit
   local nArrLen
   local xMsg
   local nMsgCol
   local nMsgRow
   local lMsgCenter
   local nSaveCursor
   local cSaveReadVar

   local lDeclared
   local bAction
   local nMouseClik

   local nPointer
   local aColor
   local cBackColor
   local cFrontColor

   // Detect if a memvar was passed

   if __mvSCOPE( cVariable ) <= HB_MV_ERROR
      __mvPUBLIC( cVariable )
      lDeclared := .T.
   else
      lDeclared := .F.
   endif

   n := eval( bBlock )

   // if no prompts were defined, exit with 0

   if s_nPointer < 1 .or. s_nPointer > len( s_aLevel )

      n := 0

   else

      s_nPointer ++
      nPointer := s_nPointer

      nArrLen := len( s_aLevel[ nPointer - 1 ] )

      // put choice in a valid range

      if !ISNUMBER( n ) .OR. n < 1
         n := 1
      endif

      if n > nArrLen
         n := nArrLen
      endif

      //

      nSaveCursor := setcursor( IIF( Set( _SET_INTENSITY ), SC_NONE, NIL ) )
      cSaveReadVar := ReadVar( upper( cVariable ) )
      xMsg := ""
      nMsgCol := 0
      nMsgRow := set( _SET_MESSAGE )
      lMsgCenter := set( _SET_MCENTER )
      lExit := .F.


      do while n <> 0

         // should we display messages?
         if nMsgRow > 0

            if ! Empty( xMsg )
               DispOutAt( nMsgRow, nMsgCol, Space( Len( xMsg ) ), .T. )
            endif

            xMsg := s_aLevel[ nPointer - 1, n, 4 ]

            // Code Block messages ( yes, they are documented! )
            if ISBLOCK( xMsg )
               xMsg := eval( xMsg )
            endif

            if !ISCHARACTER( xMsg )
               xMsg := ""
            endif

            if lMsgCenter
               nMsgCol := int( ( maxcol() - len( xMsg ) ) / 2 )
            endif

            DispOutAt( nMsgRow, nMsgCol, xMsg,, .T. )

         endif

         // save the current row
         q := n

         if s_aLevel[ s_nPointer - 1 , n , 5 ] <> nil
             aColor := COLORARRAY( s_aLevel[ s_nPointer - 1 , n , 5 ] )
             cFrontColor := IIF( EMPTY( aColor[ 1 ] ) , NIL , aColor[ 1 ] )
             cBackColor  := IIF( LEN( aColor ) > 1 , aColor[2], NIL )
         endif

         IF Set( _SET_INTENSITY )
            IF cBackColor == Nil    // Only select Color Enhace if no color was passed
               ColorSelect( CLR_ENHANCED )
            ENDIF
         ENDIF

         // highlight the prompt
         DispOutAt( s_aLevel[ nPointer - 1, n, 1 ],;
                    s_aLevel[ nPointer - 1, n, 2 ],;
                    s_aLevel[ nPointer - 1, n, 3 ],;
                    cBackColor, .T. )

         IF Set( _SET_INTENSITY )
            IF cFrontColor == NIL    // Only select Color Enhace if no color was passed
              ColorSelect( CLR_STANDARD )
            ENDIF
         ENDIF

         if lExit
            exit
         endif

         nKey := 0
         do while nKey == 0

            // wait for a keystroke
            nKey := inkey( 0 )

            if ( bAction := setkey( nKey ) ) <> NIL

               eval( bBlock, n )
               eval( bAction, procname( 1 ), procline( 1 ), upper( cVariable ) )
               n := eval( bBlock )

               if n < 1
                  n := 1
               elseif n > nArrLen
                  n := nArrLen
               endif

               nKey := 0

            endif
         enddo

         // check for keystrokes
         Switch nKey

         case K_MOUSEMOVE
            if ( ( nMouseClik := hittest(s_aLevel[ nPointer-1 ], ;
                   MRow(), MCol()) ) > 0 )
                n := nMouseClik
            endif
            EXIT

         case K_LBUTTONDOWN
         case K_LDBLCLK
            if ( ( nMouseClik := hittest(s_aLevel[ nPointer-1 ], ;
                   MRow(), MCol()) ) > 0 )
                n := nMouseClik
            endif
            /** JC: TEMPORARY CHANGE
              I want to know the opinion of other developers about dbl click in menuto
            */
            //if ( nKey == 1006 )
                lExit := .T.
            //endif
            exit

         case K_DOWN
         case K_RIGHT
            if ++n > nArrLen
               n := IIF( Set( _SET_WRAP ), 1, nArrLen )
            endif
            exit

         case K_UP
         case K_LEFT
            if --n < 1
               n := IIF( Set( _SET_WRAP ), nArrLen, 1 )
            endif
            exit

         case K_HOME
            n := 1
            exit

         case K_END
            n := nArrLen
            exit

         case K_ENTER
         case K_PGUP
         case K_PGDN
            lExit := .T.
            exit

         case K_ESC
            n := 0
            exit

         default
            // did user hit a hot key?
            for y := 1 to nArrLen
               if upper( left( ltrim( s_aLevel[ nPointer - 1, y, 3 ] ), 1 ) ) == upper( chr( nKey ) )
                  n := y
                  lExit := .T.
                  exit
               endif
            next
         end

         if n <> 0
            DispOutAt( s_aLevel[ nPointer - 1, q, 1 ],;
                       s_aLevel[ nPointer - 1, q, 2 ],;
                       s_aLevel[ nPointer - 1, q, 3 ],;
                       cFrontColor, .T. )
         endif

      enddo

      ReadVar( cSaveReadVar )
      SetCursor( nSaveCursor )

      s_nPointer := nPointer
      s_nPointer --
      asize( s_aLevel, s_nPointer - 1 )

   endif

   eval( bBlock, n )

   if lDeclared
      __mvXRELEASE( cVariable )
   endif

   SetPos( MaxRow() - 1, 0)

   return n

static function HITTEST( aMenu, nMouseRow, nMouseCol )

//   LOCAL nPos:=1
   LOCAL xMenu

   FOR EACH xMenu IN aMenu
     IF nMouseRow == xMenu[ 1 ] .AND. nMouseCol >= xMenu[ 2 ] .AND.;
          nMouseCol < xMenu[ 2 ] + Len( xMenu[ 3 ] )
//        RETURN nPos
        RETURN HB_EnumIndex()
     ENDIF
//     nPos++
   NEXT
   return 0
Foi baixado do xHarbour.org: http://www.xharbour.org/index.asp?page=download/sources os fontes neste link:
http://downloads.sourceforge.net/xharbo ... .1.src.zip

Problemas com prompt/menuto - harbour

Enviado: 24 Mar 2012 02:15
por Abel
Consegui, descobri os problemas e arrumei ...
Agora a barra rola tranquilo, nao executa a opcao se clicar fora do menu, e se abrir alguma outra rotina ela continua funcionando.

segue a rotina alterada e com os comentarios para facilitar as devidas adaptacoes de quem quiser.
é so retirar as //// e fazer um teste simples para ver como é executado, faciltando assim debugar.

Código: Selecionar todos

/*
 * $Id: menuto.prg,v 1.15 2005/12/10 00:33:33 oh1 Exp $
 * adaptada por Abel 23/03/2012
 */

/*
 * Harbour Project source code:
 * PROMPT/MENU TO commands
 *
 * Released to Public Domain by Phil Barnett 
 * www - http://www.harbour-project.org
 *
 */

/* NOTE: Recursive use is supported. */

#include "color.ch"
#include "common.ch"
#include "inkey.ch"
#include "hbmemvar.ch"
#include "setcurs.ch"
#xtranslate COLORARRAY(<x>) => &( '{"' + strtran( <x> , ',', '","') + '"}' ) // alterada

static s_aLevel   := {}
static s_nPointer := 1

function __AtPrompt( nRow, nCol, cPrompt, cMsg, cColor)

   if s_nPointer < 1
      s_nPointer := 1
   endif

   // add the current level empty array.
   do while len( s_aLevel ) < s_nPointer
      aadd( s_aLevel, {} )
   enddo

   // add to the static array
   aadd( s_aLevel[ s_nPointer ], { nRow, nCol, cPrompt, cMsg, cColor } )

   // put this prompt on the screen right now
   DispOutAt( nRow, nCol, cPrompt, cColor, .T. )

   return .f.

function __MenuTo( bBlock, cVariable )

   local nKey
   local y
   local q
   local n
   local lExit
   local nArrLen
   local xMsg
   local nMsgCol
   local nMsgRow
   local lMsgCenter
   local nSaveCursor
   local cSaveReadVar

   local lDeclared
   local bAction
   local nMouseClik

   local nPointer
   local aColor
   local cBackColor
   local cFrontColor

   SET(_SET_EVENTMASK, INKEY_ALL) // ALTERADO ABEL // LIBERA MENU DESLIZANTE  
                                  // IMPORTANTE: SE AO INVES DE INKEY_ALL COLOCAR 255 OU 1002 
                                  // O MENU NAO DESLIZA MESMO COM AS ADAPTACOES EFETUADAS
   
   // Detect if a memvar was passed

   if __mvSCOPE( cVariable ) <= HB_MV_ERROR
      __mvPUBLIC( cVariable )
      lDeclared := .T.
   else
      lDeclared := .F.
   endif

   n := eval( bBlock )

   // if no prompts were defined, exit with 0

   if s_nPointer < 1 .or. s_nPointer > len( s_aLevel )

      n := 0

   else

      s_nPointer ++
      nPointer := s_nPointer

      nArrLen := len( s_aLevel[ nPointer - 1 ] )

      // put choice in a valid range

      if !ISNUMBER( n ) .OR. n < 1
         n := 1
      endif

      if n > nArrLen
         n := nArrLen
      endif

      //

      nSaveCursor := setcursor( IIF( Set( _SET_INTENSITY ), SC_NONE, NIL ) )
      cSaveReadVar := ReadVar( upper( cVariable ) )
      xMsg := ""
      nMsgCol := 0
      nMsgRow := set( _SET_MESSAGE )
      lMsgCenter := set( _SET_MCENTER )
      lExit := .F.


      do while n <> 0 // LOOP

         // should we display messages?
         if nMsgRow > 0

            if ! Empty( xMsg )
               DispOutAt( nMsgRow, nMsgCol, Space( Len( xMsg ) ), .T. )
            endif

            xMsg := s_aLevel[ nPointer - 1, n, 4 ]

            // Code Block messages ( yes, they are documented! )
            if ISBLOCK( xMsg )
               xMsg := eval( xMsg )
            endif

            if !ISCHARACTER( xMsg )
               xMsg := ""
            endif

            if lMsgCenter
               nMsgCol := int( ( maxcol() - len( xMsg ) ) / 2 )
            endif

            DispOutAt( nMsgRow, nMsgCol, xMsg,, .T. )

         endif

         // save the current row
         q := n

         if s_aLevel[ s_nPointer - 1 , n , 5 ] <> nil
             aColor := COLORARRAY( s_aLevel[ s_nPointer - 1 , n , 5 ] )
             cFrontColor := IIF( EMPTY( aColor[ 1 ] ) , NIL , aColor[ 1 ] )
             cBackColor  := IIF( LEN( aColor ) > 1 , aColor[2], NIL )
         endif

         IF Set( _SET_INTENSITY )
            IF cBackColor == Nil    // Only select Color Enhace if no color was passed
               ColorSelect( CLR_ENHANCED )
               ////@ 2,1 SAY CLR_ENHANCED
               ////@ 3,1 SAY s_aLevel[ s_nPointer - 1 , n , 5 ]
            ENDIF
         ELSE
               
         ENDIF

         // highlight the prompt
         DispOutAt( s_aLevel[ nPointer - 1, n, 1 ],;
                    s_aLevel[ nPointer - 1, n, 2 ],;
                    s_aLevel[ nPointer - 1, n, 3 ],;
                    cBackColor, .T. )

         IF Set( _SET_INTENSITY )
            IF cFrontColor == NIL    // Only select Color Enhace if no color was passed
              ColorSelect( CLR_STANDARD )
            ENDIF
         ENDIF

         if lExit
            exit
         endif

         nKey := 0
         do while nKey == 0

            // wait for a keystroke
            nKey := inkey( 0 )
            ////@ 1,1 SAY NKEY
            ////@ 2,1 SAY MROW()
            ////@ 3,1 SAY MCOL()
            if ( bAction := setkey( nKey ) ) <> NIL
               ////@ 26,1 say 'executando programa'
               ////inkey(1)
               ////inkey(1)
               ////inkey(1)
               ////inkey(1)
               eval( bBlock, n )
               eval( bAction, procname( 1 ), procline( 1 ), upper( cVariable ) )
               n := eval( bBlock )

               if n < 1
                  n := 1
               elseif n > nArrLen
                  n := nArrLen
               endif

               nKey := 0

            endif
         enddo

         // check for keystrokes
         Switch nKey

         case K_MOUSEMOVE  // alterado abel 
            if ( ( nMouseClik := hittest(s_aLevel[ nPointer-1 ], MRow(), MCol()) ) > 0 )
                n := nMouseClik
            ENDIF
            EXIT //// vai para depois DO endcase

         case K_LBUTTONDOWN // alterado abel
            if ( ( nMouseClik := hittest(s_aLevel[ nPointer-1 ], MRow(), MCol()) ) > 0 )
                n := nMouseClik
                ////@ 27,1 say 'apertou botao 1002 n:             '+str(n,2)

            ELSE
                nMouseClik=0
                ///// @ 27,1 say 'apertou botao 1002 - fora do menu '+str(n,2)
                loop 
            ENDIF
            //
            ////inkey(3)
            ////inkey(3)
            ////inkey(3)
            ////@ 27,1 say '                                           '  
            ////inkey(2)
            ////inkey(2) 
         case K_LDBLCLK  // alterado Abel
            if ( ( nMouseClik := hittest(s_aLevel[ nPointer-1 ], MRow(), MCol()) ) > 0 )
                n := nMouseClik
            ELSE
                nMouseClik=0
                /////@ 27,1 say 'apertou botao 1006 - fora do menu '+str(n,2)
                loop
            endif
            lExit := .T.
            exit

         case K_DOWN
         case K_RIGHT
            if ++n > nArrLen
               n := IIF( Set( _SET_WRAP ), 1, nArrLen )
            endif
            exit

         case K_UP
         case K_LEFT
            if --n < 1
               n := IIF( Set( _SET_WRAP ), nArrLen, 1 )
            endif
            exit

         case K_HOME
            n := 1
            exit

         case K_END
            n := nArrLen
            exit

         case K_ENTER
         case K_PGUP
         case K_PGDN
            lExit := .T.
            exit

         case K_ESC
            n := 0
            exit

         OTHERWISE  // did user hit a hot key?
            for y := 1 to nArrLen
               if upper( left( ltrim( s_aLevel[ nPointer - 1, y, 3 ] ), 1 ) ) == upper( chr( nKey ) )
                  n := y
                  lExit := .T.
                  exit
               endif
            next
         END // fim DO switch
         
         if n <> 0
            DispOutAt( s_aLevel[ nPointer - 1, q, 1 ],;
                       s_aLevel[ nPointer - 1, q, 2 ],;
                       s_aLevel[ nPointer - 1, q, 3 ],;
                       cFrontColor, .T. )
         endif
         ////@ 26,1 SAY n COLOR 'GR+/N'
      enddo
         ////@ 17,1 say 'sai do...enddo '+str(n,2) color 'RB/N'
         ////inkey(1)
         ////inkey(1)
         ////inkey(1)
      ReadVar( cSaveReadVar )
      SetCursor( nSaveCursor )

      s_nPointer := nPointer
      s_nPointer --
      asize( s_aLevel, s_nPointer - 1 )

   endif
   ////@ 27,1 say space(80)
   ////@ 27,1 say 'vou executar programa escolhido '+str(n,2)
   ////inkey(1)
   ////inkey(1)
   eval( bBlock, n )

   if lDeclared
      __mvXRELEASE( cVariable )
   endif

   SetPos( MaxRow() - 1, 0)
   SET(_SET_EVENTMASK, 1002) // alterado Abel // EVITA A TELA TREMIDA NOS GETS COM MOUSE
   return n

static function HITTEST( aMenu, nMouseRow, nMouseCol )

   LOCAL xMenu

   FOR EACH xMenu IN aMenu
     IF nMouseRow == xMenu[ 1 ] .AND. nMouseCol >= xMenu[ 2 ] .AND. nMouseCol < xMenu[ 2 ] + Len( xMenu[ 3 ] )
        ////@ 25,1 SAY 'TA NO MENU'
        RETURN xMenu:__enumIndex() 
     ENDIF
   NEXT
   ////@ 25,1 SAY 'NAO TA NO MENU'
   return 0
Agora a criatividade é o limite ...
Valeu Pablo !!!

Problemas com prompt/menuto - harbour

Enviado: 24 Mar 2012 11:09
por Pablo César
Parabéns você conseguiu !
Eu compilei o seu exemplo junto com o menuto.prg alterado e rodou beleza !
Ao compilar deu erro pela falta da função COLORARRAY(), aí desabilitei e funciona sim !

PARABÉNS ! Gostei da sua perseverança, é assim que muitas vezes se consegue quebrar barreiras. Valeu !

Problemas com prompt/menuto - harbour

Enviado: 24 Mar 2012 13:52
por Abel
legal, sou novo no forum, nunca participei de um forum, era programador clipper e me virava como podia.

mas forum é isso, a gente aprende e ensina, da uma dica, encaminha uma solucao e colabora para que todos possam melhorar seu profissional.

Abel
Todos os horários são UTC-03:00
Página 2 de 2

Powered by phpBB® Forum Software © phpBB Limited

Traduzido por: Suporte phpBB