home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Exec 5 / CD_Magazyn_EXEC_nr_5.iso / Programy / Programowanie / BASIC / pmDevBas.lha / BigMenu.bas < prev    next >
Encoding:
BASIC Source File  |  2000-06-12  |  12.1 KB  |  474 lines
  1. ' *********************************************************************
  2. '      BigMenu © 1996-97 by Henrik Isaksson -- All Rights Reserved
  3. '                           V. 1.6 (05.09.98)
  4. '
  5. '                 C to HBASIC conversion 1.2 (11.6.00)
  6. '               by Dámaso D. Estévez <amidde@arrakis.es>
  7. '              AmiSpaTra - http://www.arrakis.es/~amidde/
  8. '
  9. '         This example shows how to create (deep ;) submenus
  10. '  Este ejemplo muestra cómo crear submenús (con mucha profundidad ;)
  11. '
  12. '         See the Layout.bas code / Vea el código de Layout.bas
  13. ' *********************************************************************
  14.  
  15. REM $include pm.bh
  16. REM $include exec.bh
  17. REM $include intuition.bh
  18. REM $include utility.bc
  19.  
  20. pmb&  = NULL&    ' PopUpMenuBase
  21. ib&   = NULL&    ' IntuitionBase
  22. gb&   = NULL&    ' GfxBase
  23. w&    = NULL&    ' Window
  24. im&   = NULL&    ' IntuiMessage
  25. p&    = NULL&    ' PopupMenu
  26. prev& = NULL&    ' PopupMenu
  27. r&    = TRUE&    ' Status flag (loop) / Bandera de estado (bucle)
  28. ok&   = FALSE&   ' Status flag / Bandera de estado
  29. i%    = 0%       ' Counter / Contador
  30.  
  31. '       Remember to increase the size array if you need
  32. '        use more tags (tags&()) or menu items (pi&()).
  33. '    Recuerde incrementar el tamaño de la matriz si necesita
  34. ' usar más etiquetas (tags&()) o crear más ítems de menú (pi&()).
  35. ' ---------------------------------------------------------------
  36. DIM tags&(28)   ' Taglist / Lista de atributos
  37. DIM pi&(13)     ' Items pointer array / Matriz de punteros de los ítems del menú
  38.  
  39. ' =====================================================================
  40. '                          The code / El código
  41. ' ====================================================================
  42.  
  43. '            "Opening" all libraries needed
  44. ' Abriendo y preparando todas las bibliotecas necesarias
  45. ' ------------------------------------------------------
  46.  
  47. LIBRARY OPEN "exec.library"
  48. LIBRARY OPEN "popupmenu.library",POPUPMENU_VERSION&
  49.  
  50. pmb&=LIBRARY("popupmenu.library")
  51.  
  52. IF pmb& <> NULL& THEN
  53.     LIBRARY VARPTR "popupmenu.library", pmb&
  54.     ib& = PEEKL(pmb& + pmb_IntuitionBase%)
  55.     IF ib& <> NULL& THEN
  56.         LIBRARY VARPTR "intuition.library", ib&
  57.         gb& = PEEKL(pmb& + pmb_GfxBase%)
  58.         IF gb& <> NULL& THEN
  59.             LIBRARY VARPTR "graphics.library", gb&
  60.             ok& = TRUE&
  61.         END IF
  62.     END IF
  63. END IF
  64.  
  65. IF ok& = TRUE& THEN
  66.  
  67.     ' PMInfo macros / Macros PMInfo
  68.     ' -----------------------------
  69.  
  70.     TAGLIST VARPTR(tags&(0)),_
  71.         PM_Title&,    SADD("Congratulations!!"+CHR$(0)),_
  72.         PM_NoSelect&, TRUE&,_
  73.         PM_ShinePen&, TRUE&,_
  74.         TAG_DONE&
  75.  
  76.     pi&(0)=PM_MakeItemA&(VARPTR(tags&(0)))
  77.  
  78.     TAGLIST VARPTR(tags&(0)),_
  79.         PM_Title&,    SADD("You've shown a great"+CHR$(0)),_
  80.         PM_NoSelect&, TRUE&,_
  81.         PM_ShinePen&, TRUE&,_
  82.         TAG_DONE&
  83.  
  84.     pi&(1)=PM_MakeItemA&(VARPTR(tags&(0)))
  85.  
  86.     TAGLIST VARPTR(tags&(0)),_
  87.         PM_Title&,    SADD("deal of patience"+CHR$(0)),_
  88.         PM_NoSelect&, TRUE&,_
  89.         PM_ShinePen&, TRUE&,_
  90.         TAG_DONE&
  91.  
  92.     pi&(2)=PM_MakeItemA&(VARPTR(tags&(0)))
  93.  
  94.     TAGLIST VARPTR(tags&(0)),_
  95.         PM_Title&,    SADD("working your way"+CHR$(0)),_
  96.         PM_NoSelect&, TRUE&,_
  97.         PM_ShinePen&, TRUE&,_
  98.         TAG_DONE&
  99.  
  100.     pi&(3)=PM_MakeItemA&(VARPTR(tags&(0)))
  101.  
  102.     TAGLIST VARPTR(tags&(0)),_
  103.         PM_Title&,    SADD("through all theese"+CHR$(0)),_
  104.         PM_NoSelect&, TRUE&,_
  105.         PM_ShinePen&, TRUE&,_
  106.         TAG_DONE&
  107.  
  108.     pi&(4)=PM_MakeItemA&(VARPTR(tags&(0)))
  109.  
  110.     TAGLIST VARPTR(tags&(0)),_
  111.         PM_Title&,    SADD("menus!"+CHR$(0)),_
  112.         PM_NoSelect&, TRUE&,_
  113.         PM_ShinePen&, TRUE&,_
  114.         TAG_DONE&
  115.  
  116.     pi&(5)=PM_MakeItemA&(VARPTR(tags&(0)))
  117.  
  118.     TAGLIST VARPTR(tags&(0)),_
  119.         PM_Title&,    SADD("You will now be"+CHR$(0)),_
  120.         PM_NoSelect&, TRUE&,_
  121.         PM_ShinePen&, TRUE&,_
  122.         TAG_DONE&
  123.  
  124.     pi&(6)=PM_MakeItemA&(VARPTR(tags&(0)))
  125.  
  126.     TAGLIST VARPTR(tags&(0)),_
  127.         PM_Title&,    SADD("rewarded with a"+CHR$(0)),_
  128.         PM_NoSelect&, TRUE&,_
  129.         PM_ShinePen&, TRUE&,_
  130.         TAG_DONE&
  131.  
  132.     pi&(7)=PM_MakeItemA&(VARPTR(tags&(0)))
  133.  
  134.     TAGLIST VARPTR(tags&(0)),_
  135.         PM_Title&,    SADD("menus option that"+CHR$(0)),_
  136.         PM_NoSelect&, TRUE&,_
  137.         PM_ShinePen&, TRUE&,_
  138.         TAG_DONE&
  139.  
  140.     pi&(8)=PM_MakeItemA&(VARPTR(tags&(0)))
  141.  
  142.     TAGLIST VARPTR(tags&(0)),_
  143.         PM_Title&,    SADD("lets you stop"+CHR$(0)),_
  144.         PM_NoSelect&, TRUE&,_
  145.         PM_ShinePen&, TRUE&,_
  146.         TAG_DONE&
  147.  
  148.     pi&(9)=PM_MakeItemA&(VARPTR(tags&(0)))
  149.  
  150.     TAGLIST VARPTR(tags&(0)),_
  151.         PM_Title&,    SADD("browsing through"+CHR$(0)),_
  152.         PM_NoSelect&, TRUE&,_
  153.         PM_ShinePen&, TRUE&,_
  154.         TAG_DONE&
  155.  
  156.     pi&(10)=PM_MakeItemA&(VARPTR(tags&(0)))
  157.  
  158.     TAGLIST VARPTR(tags&(0)),_
  159.         PM_Title&,    SADD("the menus..."+CHR$(0)),_
  160.         PM_NoSelect&, TRUE&,_
  161.         PM_ShinePen&, TRUE&,_
  162.         TAG_DONE&
  163.  
  164.     pi&(11)=PM_MakeItemA&(VARPTR(tags&(0)))
  165.  
  166.     ' PMBar macro / Macro PMBar
  167.     ' -------------------------
  168.  
  169.     TAGLIST VARPTR(tags&(0)),_
  170.         PM_WideTitleBar&, TRUE&,_
  171.         TAG_DONE&
  172.  
  173.     pi&(12) = PM_MakeItemA&(VARPTR(tags&(0)))
  174.  
  175.     ' PMItem macro / Macro PMItem
  176.     ' ---------------------------
  177.  
  178.     TAGLIST VARPTR(tags&(0)),_
  179.         PM_Title&,    SADD("Quit"+CHR$(0)), _
  180.         PM_UserData&, 5&, _
  181.         TAG_DONE&
  182.  
  183.     pi&(13) = PM_MakeItemA&(VARPTR(tags&(0)))
  184.  
  185.     '  Creating the lastest submenu (size needed: 13*2+2)
  186.     ' Creando el último submenú (tamaño necesario: 13*2+2)
  187.     ' ----------------------------------------------------
  188.     FOR i%=0 TO 13
  189.         TAGLIST VARPTR(tags&(i%*2)), _
  190.             PM_Item&,pi&(i%), _
  191.             TAG_DONE&
  192.     NEXT i%
  193.  
  194.     prev& = PM_MakeMenuA&(VARPTR(tags&(0)))
  195.  
  196.     '         Creating the submenus from #19 to #1 and linking.
  197.     ' Creando los submenús (del nº 19 al nº 1) y enlazado entre ellos.
  198.     ' ----------------------------------------------------------------
  199.  
  200.     FOR i% = 0 TO 19 STEP 1
  201.  
  202.         '     The RIGHT$ function deletes the initial extra space
  203.         '  (plus symbol not visible for numbers)... a Basic question.
  204.         ' La función RIGHT$ suprime el espacio inicial extra (símbolo
  205.         '  positivo no visible para los números)... cosas del Basic.
  206.         ' -----------------------------------------------------------
  207.  
  208.         bfr$="Submenu #"+RIGHT$(STR$(20%-i%),LEN(STR$(20%-i%))-1)+CHR$(0)
  209.  
  210.         ' First item in a submenu / Primer ítem del submenú
  211.         ' -------------------------------------------------
  212.  
  213.         TAGLIST VARPTR(tags&(0)),_
  214.             PM_Title&,    SADD(bfr$),_
  215.             PM_NoSelect&, TRUE&,_
  216.             PM_ShinePen&, TRUE&,_
  217.             TAG_DONE&
  218.  
  219.         pi&(0)=PM_MakeItemA&(VARPTR(tags&(0)))
  220.  
  221.         ' Second item in the same submenu / Segundo ítem del submenú
  222.         ' ----------------------------------------------------------
  223.  
  224.         TAGLIST VARPTR(tags&(0)),_
  225.             PM_Title&, SADD("Next Submenu"+CHR$(0)),_
  226.             PM_Sub&, prev&,_
  227.             TAG_DONE&
  228.  
  229.         pi&(1)=PM_MakeItemA&(VARPTR(tags&(0)))
  230.  
  231.         ' Now, creating the submenu / Ahora creando el submenú
  232.         ' ----------------------------------------------------
  233.  
  234.         TAGLIST VARPTR(tags&(0)),_
  235.             PM_Item&,pi&(0),_
  236.             PM_Item&,pi&(1),_
  237.             TAG_DONE&
  238.  
  239.         prev&=PM_MakeMenuA&(VARPTR(tags&(0)))
  240.  
  241.     NEXT i%
  242.  
  243.     ' ------ Menu header (PMMenu macro) ----
  244.     ' --- Cabera del menú (macro PMMenu) ---
  245.     ' --------------------------------------
  246.  
  247.     TAGLIST VARPTR(tags&(0)), _
  248.         PM_Hidden&, TRUE&, _
  249.         TAG_DONE&
  250.  
  251.     pi&(0) = PM_MakeItemA&(VARPTR(tags&(0)))
  252.  
  253.     TAGLIST VARPTR(tags&(0)),_
  254.         PM_Title&,    SADD("Big Menu"+CHR$(0)), _
  255.         PM_NoSelect&, TRUE&, _
  256.         PM_ShinePen&, TRUE&, _
  257.         PM_Shadowed&, TRUE&, _
  258.         PM_Center&,   TRUE&, _
  259.         TAG_DONE&
  260.  
  261.     pi&(1) = PM_MakeItemA&(VARPTR(tags&(0)))
  262.  
  263.     TAGLIST VARPTR(tags&(0)),_
  264.         PM_WideTitleBar&, TRUE&,_
  265.         TAG_DONE&
  266.  
  267.     pi&(2) = PM_MakeItemA&(VARPTR(tags&(0)))
  268.  
  269.     ' PMInfo macros / Macros PMInfo
  270.     ' -----------------------------
  271.  
  272.     TAGLIST VARPTR(tags&(0)),_
  273.         PM_Title&,    SADD("Welcome to the neverending"+CHR$(0)),_
  274.         PM_NoSelect&, TRUE&,_
  275.         PM_ShinePen&, TRUE&,_
  276.         TAG_DONE&
  277.  
  278.     pi&(3)=PM_MakeItemA&(VARPTR(tags&(0)))
  279.  
  280.     TAGLIST VARPTR(tags&(0)),_
  281.         PM_Title&,    SADD("submenu example."+CHR$(0)),_
  282.         PM_NoSelect&, TRUE&,_
  283.         PM_ShinePen&, TRUE&,_
  284.         TAG_DONE&
  285.  
  286.     pi&(4)=PM_MakeItemA&(VARPTR(tags&(0)))
  287.  
  288.     ' PMBar macro / Macro PMBar
  289.     ' -------------------------
  290.  
  291.     TAGLIST VARPTR(tags&(0)),_
  292.         PM_WideTitleBar&, TRUE&,_
  293.         TAG_DONE&
  294.  
  295.     pi&(5) = PM_MakeItemA&(VARPTR(tags&(0)))
  296.  
  297.     ' PMItem macro / Macro PMItem
  298.     ' ---------------------------
  299.  
  300.     TAGLIST VARPTR(tags&(0)),_
  301.         PM_Title&, SADD("Submenu"+CHR$(0)), _
  302.         PM_Sub&,   prev&, _
  303.         TAG_DONE&
  304.  
  305.     pi&(6) = PM_MakeItemA&(VARPTR(tags&(0)))
  306.  
  307.     ' PMBar macro / Macro PMBar
  308.     ' -------------------------
  309.  
  310.     TAGLIST VARPTR(tags&(0)),_
  311.         PM_WideTitleBar&, TRUE&,_
  312.         TAG_DONE&
  313.  
  314.     pi&(7) = PM_MakeItemA&(VARPTR(tags&(0)))
  315.  
  316.     ' PMItem macro / Macro PMItem
  317.     ' ---------------------------
  318.  
  319.     TAGLIST VARPTR(tags&(0)),_
  320.         PM_Title&,    SADD("Quit"+CHR$(0)), _
  321.         PM_UserData&, 5&, _
  322.         TAG_DONE&
  323.  
  324.     pi&(8) = PM_MakeItemA&(VARPTR(tags&(0)))
  325.  
  326.     '     Creating the popup menu (size needed: 8*2+2)
  327.     ' Creando el menú emergente (tamaño necesario: 13*2+2)
  328.     ' ----------------------------------------------------
  329.     FOR i%=0 TO 8
  330.         TAGLIST VARPTR(tags&(i%*2)), _
  331.             PM_Item&,pi&(i%), _            ' +2*i% array elements / elementos en la matriz
  332.             TAG_DONE&                   ' +2    array elements / elementos en la matriz
  333.     NEXT i%
  334.  
  335.     p& = PM_MakeMenuA&(VARPTR(tags&(0)))
  336.  
  337.     IF p& <> NULL& THEN
  338.  
  339.         '   Window properties
  340.         ' Atributos de la ventana
  341.         ' -----------------------
  342.         TAGLIST VARPTR(tags&(0)),_
  343.             WA_IDCMP&,       IDCMP_CLOSEWINDOW& OR IDCMP_MOUSEBUTTONS&, _
  344.             WA_RMBTrap&,     TRUE&, _
  345.             WA_DragBar&,     TRUE&, _
  346.             WA_Width&,       150, _
  347.             WA_Height&,      100, _
  348.             WA_Left&,        150, _
  349.             WA_Top&,         0, _
  350.             WA_Title&,       SADD("BigMenu"+CHR$(0)), _
  351.             WA_CloseGadget&, TRUE&,_
  352.             TAG_DONE&
  353.  
  354.         '    Opening the window: this window is only needed to find out
  355.         '  when AND where the MENU should appear AND wich SCREEN it's on.
  356.         ' Abriendo la ventana: sólo es necesaria para saber dónde y cuándo
  357.         '       el menú emergente debe aparecer y sobre qué pantalla.
  358.         ' ----------------------------------------------------------------
  359.         w& = OpenWindowTagList&(NULL&, VARPTR(tags&(0)))
  360.  
  361.         IF w& <> NULL& THEN
  362.  
  363.             '  First, a C struct simulation (see the imsg var in original C code)
  364.             '      Primero, reservo espacio para simular una estructura en C
  365.             ' (consulte la función de la variable imsg en el código original en C)
  366.             ' --------------------------------------------------------------------
  367.             imsg$=STRING$(IntuiMessage_sizeof%,CHR$(0))
  368.  
  369.             '     Disabling Basic events :)
  370.             ' Desactivando eventos del Basic :)
  371.             ' ---------------------------------
  372.             REM $event OFF
  373.  
  374.             WHILE r&
  375.  
  376.                 '  Waiting a message
  377.                 ' Esperando un mensaje
  378.                 ' --------------------
  379.                 dummy& = WaitPort&(PEEKL(w&+UserPort%))
  380.  
  381.                 DO
  382.  
  383.                     '    Get the message
  384.                     ' Se obtiene el mensaje
  385.                     ' ---------------------
  386.                     im& = GetMsg&(PEEKL(w&+UserPort%))
  387.                     IF im& THEN
  388.  
  389.                         '   ... but we will work with a copy
  390.                         ' ... pero se trabajará con una copia
  391.                         ' -----------------------------------
  392.                         CopyMem im&, SADD(imsg$), IntuiMessage_sizeof%
  393.                         ReplyMsg im&
  394.  
  395.                         tmp& = PEEKL(SADD(imsg$)+Class%)
  396.  
  397.                         SELECT CASE tmp&
  398.  
  399.                                 CASE = IDCMP_CLOSEWINDOW&
  400.                                     r& = FALSE&
  401.                                     EXIT DO
  402.  
  403.                                 CASE = IDCMP_MOUSEBUTTONS&
  404.  
  405.                                     '  The 9.03 documentation signals what the PM_Code& tag
  406.                                     '      is obsoleted!...  this is the reason because
  407.                                     '        I've changed this and I use PM_Dummy& ;-)
  408.                                     '
  409.                                     '    ¡La documentación de la versión 9.03 indica que
  410.                                     '     la etiqueta PM_Code& ha quedado obsoleta!...
  411.                                     '          por eso la he cambiado PM_Dummy& ;-)
  412.                                     ' -----------------------------------------------------
  413.                                     TAGLIST VARPTR(tags&(0)), _
  414.                                         PM_Menu&,  p&, _
  415.                                         PM_Dummy&, (SADD(imsg$)+IntuiMessageCode%), _
  416.                                         TAG_DONE&
  417.  
  418.                                     '  Opening finally my popupmenu menu
  419.                                     ' Abriendo finalmente mi menú emergente
  420.                                     ' -------------------------------------
  421.                                     r& = PM_OpenPopupMenuA&(w&, VARPTR(tags&(0))) - 5&
  422.  
  423.                                     EXIT DO
  424.  
  425.                         END SELECT
  426.  
  427.                     ELSE
  428.  
  429.                         EXIT LOOP
  430.  
  431.                     END IF
  432.  
  433.                 LOOP
  434.  
  435.             WEND
  436.  
  437.             '    Reenabling Basic events :)
  438.             ' Reactivando eventos del Basic :)
  439.             ' --------------------------------
  440.             REM $event ON
  441.  
  442.             CloseWindow& w&
  443.  
  444.         ELSE
  445.  
  446.             PRINT "Window error!"
  447.  
  448.         END IF
  449.  
  450.         PM_FreePopupMenu& p&
  451.  
  452.     ELSE
  453.  
  454.         PRINT "Menu error!"
  455.  
  456.     END IF
  457.  
  458. ELSE
  459.  
  460.     PRINT "One or more libraries have failed!"
  461.  
  462. END IF
  463.  
  464. IF gb&  <> NULL& THEN LIBRARY VARPTR "graphics.library",  NULL&
  465. IF ib&  <> NULL& THEN LIBRARY VARPTR "intuition.library", NULL&
  466.  
  467. '          Safe, even if the program fails to open the libraries
  468. ' Método seguro, incluso aunque el programa falle al abrir las bibliotecas
  469. ' ------------------------------------------------------------------------
  470. LIBRARY CLOSE "popupmenu.library"
  471. LIBRARY CLOSE "exec.library"
  472.  
  473. END
  474.