home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Exec 5 / CD_Magazyn_EXEC_nr_5.iso / Programy / Programowanie / BASIC / pmDevBas.lha / SimpleMenu.bas < prev    next >
Encoding:
BASIC Source File  |  2000-06-12  |  7.6 KB  |  297 lines
  1. ' *********************************************************************
  2. '     SimpleMenu © 1996-99 by Henrik Isaksson -- All Rights Reserved
  3. '                           V. 3.0 (23.8.99)
  4. '
  5. '                  C to HBASIC conversion 1.0 (8.6.00)
  6. '               by Dámaso D. Estévez <amidde@arrakis.es>
  7. '              AmiSpaTra - http://www.arrakis.es/~amidde/
  8. '
  9. '             Opens a popup menu... only the Quit item works.
  10. '
  11. '    Abre un menú emergente... sólo el ítem Quit (Salir) funciona.
  12. '
  13. '       See the Disable.bas code / Vea el código de Disable.bas
  14. ' *********************************************************************
  15.  
  16. REM $include pm.bh
  17. REM $include exec.bh
  18. REM $include intuition.bh
  19. REM $include utility.bc
  20.  
  21. pmb&  = NULL&   ' PopUpMenuBase
  22. ib&   = NULL&   ' IntuitionBase
  23. w&    = NULL&   ' Window
  24. im&   = NULL&   ' IntuiMessage
  25. p&    = NULL&   ' PopupMenu
  26. r&    = TRUE&   ' Status flag (loop) / Bandera de estado (bucle)
  27. ok&   = FALSE&  ' Status flag / Bandera de estado
  28.  
  29. '       Remember to increase the size array if you need
  30. '        use more tags (tags&()) or menu items (i&()).
  31. '    Recuerde incrementar el tamaño de la matriz si necesita
  32. ' usar más etiquetas (tags&()) o crear más ítems de menú (i&()).
  33. ' ---------------------------------------------------------------
  34. DIM tags&(20)   ' Taglist / Lista de atributos
  35. DIM i&(6)       ' Items pointers array / Matriz de punteros de los ítems del menú
  36.  
  37. ' =====================================================================
  38. '                          The code / El código
  39. ' =====================================================================
  40.  
  41. '            "Opening" all libraries needed
  42. ' Abriendo y preparando todas las bibliotecas necesarias
  43. ' ------------------------------------------------------
  44.  
  45. LIBRARY OPEN "exec.library"
  46. LIBRARY OPEN "popupmenu.library",POPUPMENU_VERSION&
  47.  
  48. pmb&=LIBRARY("popupmenu.library")
  49.  
  50. IF pmb& <> NULL& THEN
  51.     LIBRARY VARPTR "popupmenu.library", pmb&
  52.     ib& = PEEKL(pmb& + pmb_IntuitionBase%)
  53.     IF ib& <> NULL& THEN
  54.         LIBRARY VARPTR "intuition.library", ib&
  55.         ok& = TRUE&
  56.     END IF
  57. END IF
  58.  
  59. IF ok& = TRUE& THEN
  60.  
  61.     ' ----- Menu header (PMMenu macro) ----
  62.     ' -- Cabecera del menú (macro PMMenu)--
  63.     ' -------------------------------------
  64.  
  65.     '   First menu item (not visible)
  66.     ' Primer ítem del menú (no visible)
  67.     ' ---------------------------------
  68.     TAGLIST VARPTR(tags&(0)), _
  69.         PM_Hidden&, TRUE&, _
  70.         TAG_DONE&
  71.  
  72.     i&(0) = PM_MakeItemA&(VARPTR(tags&(0)))
  73.  
  74.     '    Second menu item (title)
  75.     ' Segundo ítem del menú (título)
  76.     ' ------------------------------
  77.     TAGLIST VARPTR(tags&(0)),_
  78.         PM_Title&,SADD("SimpleMenu"+CHR$(0)), _
  79.         PM_NoSelect&, TRUE&, _
  80.         PM_ShinePen&, TRUE&, _
  81.         PM_Shadowed&, TRUE&, _
  82.         PM_Center&,   TRUE&, _
  83.         TAG_DONE&
  84.  
  85.     i&(1) = PM_MakeItemA&(VARPTR(tags&(0)))
  86.  
  87.     '     Third menu item (separator bar)
  88.     ' Tercer ítem del menú (barra separadora)
  89.     ' ---------------------------------------
  90.     TAGLIST VARPTR(tags&(0)), _
  91.         PM_WideTitleBar&, TRUE&, _
  92.         TAG_DONE&
  93.  
  94.     i&(2) = PM_MakeItemA&(VARPTR(tags&(0)))
  95.  
  96.     ' ----- The other menu entries -----
  97.     ' ------- Restantes entradas -------
  98.     ' ----------------------------------
  99.  
  100.     '   Fourth menu item
  101.     ' Cuarto ítem del menú
  102.     ' --------------------
  103.     TAGLIST VARPTR(tags&(0)), _
  104.         PM_Title&, SADD("Item1"+CHR$(0)), _
  105.         TAG_DONE&
  106.  
  107.     i&(3) = PM_MakeItemA&(VARPTR(tags&(0)))
  108.  
  109.     '    Fifth menu item
  110.     ' Quinto ítem del menú
  111.     ' --------------------
  112.     TAGLIST VARPTR(tags&(0)), _
  113.         PM_Title&, SADD("Item2"+CHR$(0)), _
  114.         TAG_DONE&
  115.  
  116.     i&(4) = PM_MakeItemA&(VARPTR(tags&(0)))
  117.  
  118.     '    Sixth menu item (separator bar)
  119.     ' Sexto ítem del menú (barra separadora)
  120.     ' --------------------------------------
  121.     TAGLIST VARPTR(tags&(0)), _
  122.         PM_TitleBar&, TRUE&, _
  123.         TAG_DONE&
  124.  
  125.     i&(5) = PM_MakeItemA&(VARPTR(tags&(0)))
  126.  
  127.     '  Seventh menu item
  128.     ' Séptimo ítem del menú
  129.     ' ---------------------
  130.     TAGLIST VARPTR(tags&(0)), _
  131.         PM_Title&,    SADD("Quit"+CHR$(0)), _
  132.         PM_UserData&, 5&, _
  133.         TAG_DONE&
  134.  
  135.     i&(6) = PM_MakeItemA&(VARPTR(tags&(0)))
  136.  
  137.     '  Creating the popup menu
  138.     ' Creando el menú emergente
  139.     ' -------------------------
  140.  
  141.     TAGLIST VARPTR(tags&(0)), _
  142.         PM_Item&,i&(0), _
  143.         PM_Item&,i&(1), _
  144.         PM_Item&,i&(2), _
  145.         PM_Item&,i&(3), _
  146.         PM_Item&,i&(4), _
  147.         PM_Item&,i&(5), _
  148.         PM_Item&,i&(6), _
  149.         TAG_DONE&
  150.  
  151.     p& = PM_MakeMenuA&(VARPTR(tags&(0)))
  152.  
  153.     IF p& <> NULL& THEN
  154.  
  155.         '   Window properties
  156.         ' Atributos de la ventana
  157.         ' -----------------------
  158.         TAGLIST VARPTR(tags&(0)),_
  159.             WA_IDCMP&,       IDCMP_CLOSEWINDOW& OR IDCMP_MOUSEBUTTONS&, _
  160.             WA_RMBTrap&,     TRUE&, _
  161.             WA_DragBar&,     TRUE&, _
  162.             WA_Width&,       150, _
  163.             WA_Height&,      100, _
  164.             WA_Left&,        150, _
  165.             WA_Top&,         0, _
  166.             WA_Title&,       SADD("SimpleMenu"+CHR$(0)), _
  167.             WA_CloseGadget&, TRUE&,_
  168.             TAG_DONE&
  169.  
  170.         '  Opening the window: this is only needed for to obtain
  171.         '      some info (font, screen, window position etc).
  172.         ' Abriendo la ventana: ésta sólo es necesaria para obtener
  173.         '    cierta información (tipografía a utilizar, pantalla
  174.         '  sobre la que abrir el menú, posición de la ventana...).
  175.         ' ---------------------------------------------------------
  176.         w& = OpenWindowTagList&(NULL&, VARPTR(tags&(0)))
  177.  
  178.         IF w& <> NULL& THEN
  179.  
  180.             '      A C struct simulation (see the imsg var in original C code).
  181.             '    Reservo espacio para simular una estructura en C que voy a usar
  182.             ' (consulte la función de la variable imsg en el código original en C).
  183.             ' ---------------------------------------------------------------------
  184.             imsg$=STRING$(IntuiMessage_sizeof%,CHR$(0))
  185.  
  186.             '     Disabling Basic events :)
  187.             ' Desactivando eventos del Basic :)
  188.             ' ---------------------------------
  189.             REM $event OFF
  190.  
  191.             WHILE r&
  192.  
  193.                 '  Waiting a message
  194.                 ' Esperando un mensaje
  195.                 ' --------------------
  196.                 tmp& = WaitPort&(PEEKL(w&+UserPort%))
  197.  
  198.                 DO
  199.  
  200.                     '    Get the message
  201.                     ' Se obtiene el mensaje
  202.                     ' ---------------------
  203.                     im& = GetMsg&(PEEKL(w&+UserPort%))
  204.                     IF im& THEN
  205.  
  206.                         '   ... but we will work with a copy
  207.                         ' ... pero se trabajará con una copia
  208.                         ' -----------------------------------
  209.                         CopyMem im&, SADD(imsg$), IntuiMessage_sizeof%
  210.                         ReplyMsg im&
  211.  
  212.                         tmp& = PEEKL(SADD(imsg$)+Class%)
  213.  
  214.                         SELECT CASE tmp&
  215.  
  216.                                 CASE = IDCMP_CLOSEWINDOW&
  217.                                     r& = FALSE&
  218.                                     EXIT DO
  219.  
  220.                                 CASE = IDCMP_MOUSEBUTTONS&
  221.  
  222.                                     TAGLIST VARPTR(tags&(0)), _
  223.                                         PM_Menu&, p&, _
  224.                                         TAG_DONE&
  225.  
  226.                                     '  Opening finally my popupmenu menu
  227.                                     ' Abriendo finalmente mi menú emergente
  228.                                     ' -------------------------------------
  229.                                     r& = PM_OpenPopupMenuA&(w&, VARPTR(tags&(0)))
  230.  
  231.  
  232.                                     IF r& = 5& THEN
  233.                                         r& = FALSE&
  234.                                     ELSE
  235.                                         r& = TRUE&
  236.                                     END IF
  237.  
  238.                                     EXIT DO
  239.  
  240.                                     '  If the user selects Quit, the function returns
  241.                                     '       the UserData value defined (5&)...
  242.                                     '    in other case, this returns 0& (=FALSE&).
  243.                                     '  Mr Isaksson signals about other way of handling
  244.                                     '      the input via the PM_MenuHandler tag.
  245.                                     '      Si el usuario elige la opción "Quit",
  246.                                     ' la función devolverá el valor UserData definido
  247.                                     '   (5&)... en otro caso, devuelve 0& (=FALSE&).
  248.                                     '   El Sr. Isaksson menciona como otra forma de
  249.                                     '    manejar las entradas del usuario a través
  250.                                     '          de la etiqueta PM_MenuHandler.
  251.  
  252.                         END SELECT
  253.  
  254.                     ELSE
  255.  
  256.                         EXIT LOOP
  257.  
  258.                     END IF
  259.  
  260.                 LOOP
  261.  
  262.             WEND
  263.  
  264.             '    Reenabling Basic events :)
  265.             ' Reactivando eventos del Basic :)
  266.             ' --------------------------------
  267.             REM $event ON
  268.  
  269.             CloseWindow& w&
  270.  
  271.         ELSE
  272.  
  273.             PRINT "Window error!"
  274.  
  275.         END IF
  276.  
  277.         PM_FreePopupMenu& p&
  278.  
  279.     ELSE
  280.  
  281.         PRINT "Menu error!"
  282.  
  283.     END IF
  284.  
  285. ELSE
  286.  
  287.     PRINT "One or more libraries have failed!"
  288.  
  289. END IF
  290.  
  291. IF ib&  <> NULL& THEN LIBRARY VARPTR "intuition.library", NULL&
  292.  
  293. LIBRARY CLOSE "popupmenu.library"
  294. LIBRARY CLOSE "exec.library"
  295.  
  296. END
  297.