Jump to content
Fivewin Brasil

TsShowmenu, alguem usa?

Eroni

By Eroni
in Programação

 Share

Recommended Posts

Eroni Newbie

Eroni

Posted
Posted

Boa tarde, baixei daqui do site o referido, por acaso alguem usa? Postei o código abaixo, praticamente o original so mudando umas linhas e vejam o que acontece:

* TstShowMenu.prg

* Montagem e controle de menus.

#include "FiveWin.ch"

#define KEYEVENTF_KEYUP 2

function Main()

memvar oWnd

private oWnd

define window oWnd title "Teste de ShowMenu()" mdi from 0,0 to 15,80 menu MenuGer()

activate window oWnd

return NIL

*** * Fim de Main() = Teste.

static function SuaAcao()

LOCAL oDlg

define window oDlg title "Teste de ShowMenu()" from 5,5 to 15,40

activate window oDlg

ShowMenu()

return NIL

*** * Fim de SuaAcao = Teste.

//-----------------------------------------------------------------------------

// Recupera mensagens dos itens do menu do resource/stringable.

static function MenuGer()

local oMnu

MENU oMnu

MENUITEM "SubMenu 1"

MENU

MENUITEM "Item 1.1" ACTION SuaAcao()

MENUITEM "Item 1.2" ACTION SuaAcao()

SEPARATOR

MENUITEM "Item 1.3" ACTION SuaAcao()

MENUITEM "SubMenu 1.1"

MENU

MENUITEM "Item 1.1.1" ACTION SuaAcao()

MENUITEM "Item 1.1.2" ACTION SuaAcao()

MENUITEM "Item 1.1.3" ACTION SuaAcao()

MENUITEM "Item 1.1.4" ACTION SuaAcao()

ENDMENU

SEPARATOR

MENUITEM "Item 1.4" ACTION SuaAcao()

ENDMENU

SEPARATOR

MENUITEM "Item 1" ACTION SuaAcao()

MENUITEM "SubMenu 2"

MENU

MENUITEM "Item 2.1" ACTION SuaAcao()

SEPARATOR

MENUITEM "Item 2.2" ACTION SuaAcao()

MENUITEM "SubMenu 2.1"

MENU

MENUITEM "Item 2.1.1" ACTION SuaAcao()

MENUITEM "Item 2.1.2" ACTION SuaAcao()

MENUITEM "SubMenu 2.1.1"

MENU

MENUITEM "Item 2.1.1.1" ACTION SuaAcao()

MENUITEM "Item 2.1.1.2" ACTION SuaAcao()

SEPARATOR

MENUITEM "Item 2.1.1.3" ACTION SuaAcao()

MENUITEM "Item 2.1.1.4" ACTION SuaAcao()

ENDMENU

MENUITEM "Item 2.1.3" ACTION SuaAcao()

MENUITEM "Item 2.1.4" ACTION SuaAcao()

ENDMENU

MENUITEM "Item 2.3" ACTION SuaAcao()

SEPARATOR

MENUITEM "SubMenu 2.2"

MENU

MENUITEM "Item 2.2.1" ACTION SuaAcao()

MENUITEM "Item 2.2.2" ACTION SuaAcao()

MENUITEM "Item 2.2.3" ACTION SuaAcao()

MENUITEM "Item 2.2.4" ACTION SuaAcao()

ENDMENU

MENUITEM "Item 2.4" ACTION SuaAcao()

ENDMENU

ENDMENU

return oMnu

*** * Fim de MenuGer( oM ) = Teste.

//-----------------------------------------------------------------------------

// Reabre o menu que chamou uma rotina.

// 1§ Descobre o caminho para se chegar ate oM:LastItem()

// 2§ Abre o menu simulando a tecla Alt e, em seguida, a

// sequencia de setas para chegar ate oM:LastItem()

function ShowMenu( oM, nNiv )

local nItem, oLItM, cMov :="", cMv, nChr

default oM :=WndMain():oMenu

default nNiv :=0

oLItM :=oM:LastItem()

for nItem :=1 to Len( oM:aItems )

if ValType( oM:aItems[nItem]:bAction ) ='O'

cMv :=ShowMenu( oM:aItems[nItem]:bAction, nNiv+1 )

if Right( cMv,1 ) =="x"

cMov += Chr( if( nNiv =0, VK_DOWN, VK_RIGHT ) )+cMv

if nNiv ==0

cMov :=Left( cMov,Len(cMov)-1 )

* MsgInfo( StrTran( StrTran( cMov,Chr(VK_DOWN),"V" ), Chr(VK_RIGHT), ">" ) )

keybd_event( VK_MENU,0,0,0)

keybd_event( VK_MENU,0,KEYEVENTF_KEYUP,0)

for nChr :=1 to Len( cMov )

keybd_event( Asc(SubStr(cMov,nChr,1)),0,0,0 )

keybd_event( Asc(SubStr(cMov,nChr,1)),0,KEYEVENTF_KEYUP,0 )

next

return .T.

endif

return cMov

endif

else

if oM:aItems[nItem]:nId == oLItM:nId

return cMov+"x"

endif

endif

if !Empt( oM:aItems[nItem]:cPrompt ) // se não for um separador

cMov +=Chr( if( nNiv =0, VK_RIGHT, VK_DOWN ) )

endif

next

return if(nNiv ==0, .F., "")

***

************************************************************

DLL32 FUNCTION keybd_event(bVk as _INT,bScan as _INT,dwFlags ;

as LONG,dwExtraInfo as LONG) AS LONG PASCAL LIB "user32.dll"

************************************************************

//-----------------------------------------------------------------------------

***** Fim de TstShowMenu.prg

(48) 3045-1575

xHarbour 0.99.5 & FWH 2.4

SqlLib, MySql & Dbf

Link to comment
Share on other sites
Eroni Newbie

Eroni

Posted
  • Author
Posted

Boa tarde, baixei daqui do site o referido, por acaso alguem usa? Postei o código abaixo, praticamente o original so mudando umas linhas e vejam o que acontece:

* TstShowMenu.prg

* Montagem e controle de menus.

#include "FiveWin.ch"

#define KEYEVENTF_KEYUP 2

function Main()

memvar oWnd

private oWnd

define window oWnd title "Teste de ShowMenu()" mdi from 0,0 to 15,80 menu MenuGer()

activate window oWnd

return NIL

*** * Fim de Main() = Teste.

static function SuaAcao()

LOCAL oDlg

define window oDlg title "Teste de ShowMenu()" from 5,5 to 15,40

activate window oDlg

ShowMenu()

return NIL

*** * Fim de SuaAcao = Teste.

//-----------------------------------------------------------------------------

// Recupera mensagens dos itens do menu do resource/stringable.

static function MenuGer()

local oMnu

MENU oMnu

MENUITEM "SubMenu 1"

MENU

MENUITEM "Item 1.1" ACTION SuaAcao()

MENUITEM "Item 1.2" ACTION SuaAcao()

SEPARATOR

MENUITEM "Item 1.3" ACTION SuaAcao()

MENUITEM "SubMenu 1.1"

MENU

MENUITEM "Item 1.1.1" ACTION SuaAcao()

MENUITEM "Item 1.1.2" ACTION SuaAcao()

MENUITEM "Item 1.1.3" ACTION SuaAcao()

MENUITEM "Item 1.1.4" ACTION SuaAcao()

ENDMENU

SEPARATOR

MENUITEM "Item 1.4" ACTION SuaAcao()

ENDMENU

SEPARATOR

MENUITEM "Item 1" ACTION SuaAcao()

MENUITEM "SubMenu 2"

MENU

MENUITEM "Item 2.1" ACTION SuaAcao()

SEPARATOR

MENUITEM "Item 2.2" ACTION SuaAcao()

MENUITEM "SubMenu 2.1"

MENU

MENUITEM "Item 2.1.1" ACTION SuaAcao()

MENUITEM "Item 2.1.2" ACTION SuaAcao()

MENUITEM "SubMenu 2.1.1"

MENU

MENUITEM "Item 2.1.1.1" ACTION SuaAcao()

MENUITEM "Item 2.1.1.2" ACTION SuaAcao()

SEPARATOR

MENUITEM "Item 2.1.1.3" ACTION SuaAcao()

MENUITEM "Item 2.1.1.4" ACTION SuaAcao()

ENDMENU

MENUITEM "Item 2.1.3" ACTION SuaAcao()

MENUITEM "Item 2.1.4" ACTION SuaAcao()

ENDMENU

MENUITEM "Item 2.3" ACTION SuaAcao()

SEPARATOR

MENUITEM "SubMenu 2.2"

MENU

MENUITEM "Item 2.2.1" ACTION SuaAcao()

MENUITEM "Item 2.2.2" ACTION SuaAcao()

MENUITEM "Item 2.2.3" ACTION SuaAcao()

MENUITEM "Item 2.2.4" ACTION SuaAcao()

ENDMENU

MENUITEM "Item 2.4" ACTION SuaAcao()

ENDMENU

ENDMENU

return oMnu

*** * Fim de MenuGer( oM ) = Teste.

//-----------------------------------------------------------------------------

// Reabre o menu que chamou uma rotina.

// 1§ Descobre o caminho para se chegar ate oM:LastItem()

// 2§ Abre o menu simulando a tecla Alt e, em seguida, a

// sequencia de setas para chegar ate oM:LastItem()

function ShowMenu( oM, nNiv )

local nItem, oLItM, cMov :="", cMv, nChr

default oM :=WndMain():oMenu

default nNiv :=0

oLItM :=oM:LastItem()

for nItem :=1 to Len( oM:aItems )

if ValType( oM:aItems[nItem]:bAction ) ='O'

cMv :=ShowMenu( oM:aItems[nItem]:bAction, nNiv+1 )

if Right( cMv,1 ) =="x"

cMov += Chr( if( nNiv =0, VK_DOWN, VK_RIGHT ) )+cMv

if nNiv ==0

cMov :=Left( cMov,Len(cMov)-1 )

* MsgInfo( StrTran( StrTran( cMov,Chr(VK_DOWN),"V" ), Chr(VK_RIGHT), ">" ) )

keybd_event( VK_MENU,0,0,0)

keybd_event( VK_MENU,0,KEYEVENTF_KEYUP,0)

for nChr :=1 to Len( cMov )

keybd_event( Asc(SubStr(cMov,nChr,1)),0,0,0 )

keybd_event( Asc(SubStr(cMov,nChr,1)),0,KEYEVENTF_KEYUP,0 )

next

return .T.

endif

return cMov

endif

else

if oM:aItems[nItem]:nId == oLItM:nId

return cMov+"x"

endif

endif

if !Empt( oM:aItems[nItem]:cPrompt ) // se não for um separador

cMov +=Chr( if( nNiv =0, VK_RIGHT, VK_DOWN ) )

endif

next

return if(nNiv ==0, .F., "")

***

************************************************************

DLL32 FUNCTION keybd_event(bVk as _INT,bScan as _INT,dwFlags ;

as LONG,dwExtraInfo as LONG) AS LONG PASCAL LIB "user32.dll"

************************************************************

//-----------------------------------------------------------------------------

***** Fim de TstShowMenu.prg

(48) 3045-1575

xHarbour 0.99.5 & FWH 2.4

SqlLib, MySql & Dbf

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
×
 Share
Go to topic listing
×
×
  • Create New...