Segue aparte do código onde chamo a função, copiado do Help do xHarbour (mas acho que cabe no Harbour, como no seu exemplo):
Código: Selecionar todos
/*****
* Function CreateMainMenu()
* createmainmenu.prg
*****/
FUNCTION CreateMainMenu()
LOCAL oMainMenu := TopBarMenu():new( 1, 0, MaxCol() )
LOCAL bMenuBlock := {|o| MenuSelect(o) }
LOCAL cMenuColor := "N+/W,W+/N,GR+/W,GR+/N,W+/N,N+/W"
LOCAL aItems
oMainMenu:colorSpec := cMenuColor
aItems := { ;
{ " &Banco de Dados ", {|| pBcoCria()} , "Cria um diretório de dados para cada empresa cadastrada" , 100 }, ;
{ " &Gerais ", {|| pGerCad()} , "Cadastra os códigos de fazendas, comentários, categorias, etc." , 101 }, ;
{ " &Vacas ", {|| pVentre()} , "Manutençäo dos dados das vacas (ident, idade, pai, mäe, etc.)" , 102 }, ;
{ " &Touros ", {|| pTouro()} , "Cadastro das informaçöes dos touros (tat, apelido, registro, etc.)", 103 }, ;
{ " &Reprodução ", {|| pReprod()} , "Manutençäo dos dados de reproduçäo (inseminaçäo e monta)" , 104 }, ;
{ " &Nascimento ", {|| pNascimento()}, "Inclusäo do nascimento dos terneiros/bezerros" , 105 }, ;
{ " &Desmame ", {|| pDesmame()} , "Cadastro dos dados de desmame dos terneiros/bezerros" , 106 }, ;
{ " &Pós-Desmame ", {|| pPosDesm()} , "Cadastro dos dados de pós-desmame dos terneiros/bezerros" , 107 }, ;
{ " Animais de C&EIP ", {|| pCeip()} , "Opçöes para animais que receberäo CEIP" , 108 }, ;
{ " &Ultrassom ", {|| pUltrasom()} , "Manutenção dos dados importados de ultrassom" , 109 }, ;
{ " &Ocorrências ", {|| pOcorrenc()} , "Cadastro de ocorrências" , 110 }, ;
{ " R&astreabilidade ", {|| pRastreab()} , "Cadastro de informações para a rastreabilidade" , 111 }, ;
{ " &Inclui Pesagens ", {|| pPesagens()} , "Cadastro de até 36 pesagens por animal de acordo com seleçäo" , 112 }, ;
{ " A&casalamentos - PAD ", {|| pPad()} , "Programa de Acasalamentos Dirigidos - PAD" , 113 }, ;
{ " &Sair ", {|| Sair()} , "Sai do Sistema" , 114 } ;
}
CreateSubMenu( oMainMenu, " Ca&dastrar ", bMenuBlock, aItems )
aItems := { ;
{ " &Relatórios AVG ", {|| pConsAvg()} , "Consulta aos relatórios de avaliaçäo genética" , 200 }, ;
{ " Consulta &Touros ", {|| pConsTou()} , "Consulta nomes e registros de touros em arquivo GenSys", 201 }, ;
{ " &Ficha de Animal ", {|| pOpcFicha()}, "Consulta dados de vacas de produtos" , 202 } ;
}
CreateSubMenu( oMainMenu, " C&onsultar ", bMenuBlock, aItems )
aItems := { ;
{ " &Dados Avaliaçäo ", {|| pDadosAval()} , "Exporta os dados em arquivos para a avaliaçäo genética" , 300}, ;
{ " &Rastreabilidade ", {|| pExpImpRast()} , "Exporta/Importa dados para a rastreabilidade" , 302}, ;
{ " &Importar ", {|| pImportar()} , "Importa dados de arq. ultra-som e avaliaçäo genética" , 303}, ;
{ " &Transferências ", {|| pTransfAni()} , "Transfere e importa animais de uma fazenda para outra" , 304}, ;
{ " Imprime &Boletins ", {|| pImprBol(08,47,13,58,'ADV','GC')}, "Imprime boletins gerados pelo exp.dados de avaliaçäo genética",305} ;
}
CreateSubMenu( oMainMenu, " &Exp./Imp. ", bMenuBlock, aItems )
aItems := { ;
{ " &A.N.C. ", {|| pDadosAnc()}, "Emite relatórios para a ANC", 400} ;
}
CreateSubMenu( oMainMenu, " &Associaçäo ", bMenuBlock, aItems )
aItems := { ;
{ " &Organizar ", {|| pIndexa()} , "Organiza os arquivos de índice do sistema", 500},;
{ " Al&tera cores ", {|| pAltCor()} , "Altera as cores do sistema" , 501},;
{ " Calcu&ladora ", {|| fCalculadora()}, "Aciona a calculadora" , 502},;
{ " &Impressora ", {|| pImpressora()} , "Configura a impressora a ser utilizada" , 503};
}
CreateSubMenu( oMainMenu, " &Utilitários ", bMenuBlock, aItems )
RETURN oMainMenu
/*****
* Funcition CreateSubMenu()
* createsubmenu.prg
*****/
FUNCTION CreateSubMenu( oMenu, cMenuItem, bBlock, aItems )
LOCAL aItem, oItem, oSubMenu
oSubMenu := PopUp():new()
oSubMenu:colorSpec := oMenu:colorSpec
FOR EACH aItem IN aItems
oItem := MenuItem():new( aItem[1], ;
aItem[2], ; // bBlock , ;
, ; // aItem[2], ;
aItem[3], ;
aitem[4] )
oSubMenu:addItem ( oItem )
NEXT
oItem := MenuItem():new( cMenuItem, oSubMenu )
oMenu:addItem( oItem )
RETURN NIL
/*****
* Procedure MenuSelect()
* menuselect.prg
*****/
PROCEDURE MenuSelect( oMenuItem )
@ 1, 0 CLEAR TO MaxRow(), MaxCol()
SWITCH oMenuItem:ID
CASE 114
ExitRoutine() ; EXIT
// DEFAULT
// Alert( oMenuItem:message )
END
RETURN
/*****
*Procedure ExitRoutine()
* exitroutine.prg
*****/
PROCEDURE ExitRoutine
IF Alert( "Exit program?", { "Yes", "No" } ) == 1
QUIT
ENDIF
RETURN