home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Exec 5 / CD_Magazyn_EXEC_nr_5.iso / Programy / Programowanie / BASIC / pmDevBas.lha / Disable.bas < prev    next >
Encoding:
BASIC Source File  |  2000-06-12  |  8.8 KB  |  330 lines
  1. ' *********************************************************************
  2. '      Disable © 1996-97 by Henrik Isaksson -- All Rights Reserved
  3. '                           V. 2.0 (05.09.98)
  4. '
  5. '                 C to HBASIC conversion 1.0a (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 with a checkmark menu item and a submenu...
  10. '                 the first item controls the second.
  11. '
  12. '   Abre un menu emergente con un ítem tipo "marca de verificación"
  13. '                  y un ítem que abre un submenú...
  14. '    controlando el primero el estado/funcionamiento del segundo.
  15. '
  16. '         See the BigMenu.bas code / Vea el código de BigMenu.bas
  17. ' *********************************************************************
  18.  
  19. REM $include pm.bh
  20. REM $include exec.bh
  21. REM $include intuition.bh
  22. REM $include utility.bc
  23.  
  24. pmb&  = NULL&   ' PopUpMenuBase
  25. ib&   = NULL&   ' IntuitionBase
  26. gb&   = NULL&   ' GfxBase
  27. w&    = NULL&   ' Window
  28. im&   = NULL&   ' IntuiMessage
  29. p&    = NULL&   ' PopupMenu
  30. r&    = TRUE&   ' Status flag (loop) / Bandera de estado (bucle)
  31. ok&   = FALSE&  ' Status flag / Bandera de estado
  32. tmp&  = NULL&   ' Misc. var / Variable de varios usos
  33.  
  34. '       Remember to increase the size array if you need
  35. '        use more tags (tags&()) or menu items (ii&()).
  36. '    Recuerde incrementar el tamaño de la matriz si necesita
  37. ' usar más etiquetas (tags&()) o crear más ítems de menú (ii&()).
  38. ' ---------------------------------------------------------------
  39. DIM tags&(16)   ' Taglist / Lista de atributos
  40. DIM ii&(8)      ' Menu pointers array / Matriz de punteros del menú
  41.  
  42. ' =====================================================================
  43. '                          The code / El código
  44. ' =====================================================================
  45.  
  46. '            "Opening" all libraries needed
  47. ' Abriendo y preparando todas las bibliotecas necesarias
  48. ' ------------------------------------------------------
  49.  
  50. LIBRARY OPEN "exec.library"
  51. LIBRARY OPEN "popupmenu.library",POPUPMENU_VERSION&
  52.  
  53. pmb&=LIBRARY("popupmenu.library")
  54.  
  55. IF pmb& <> NULL& THEN
  56.     LIBRARY VARPTR "popupmenu.library", pmb&
  57.     ib& = PEEKL(pmb& + pmb_IntuitionBase%)
  58.     IF ib& <> NULL& THEN
  59.         LIBRARY VARPTR "intuition.library", ib&
  60.         gb& = PEEKL(pmb& + pmb_GfxBase%)
  61.         IF gb& <> NULL& THEN
  62.             LIBRARY VARPTR "graphics.library", gb&
  63.             ok& = TRUE&
  64.         END IF
  65.     END IF
  66. END IF
  67.  
  68. IF ok& = TRUE& THEN
  69.  
  70.     ' ------ Menu header (PMMenu macro) ----
  71.     ' --- Cabera del menú (macro PMMenu) ---
  72.     ' --------------------------------------
  73.  
  74.     '   First menu item (not visible)
  75.     ' Primer ítem del menú (no visible)
  76.     ' ---------------------------------
  77.     TAGLIST VARPTR(tags&(0)), _
  78.         PM_Hidden&, TRUE&, _
  79.         TAG_DONE&
  80.  
  81.     ii&(0) = PM_MakeItemA&(VARPTR(tags&(0)))
  82.  
  83.     '    Second menu item (title)
  84.     ' Segundo ítem del menú (título)
  85.     ' ------------------------------
  86.     TAGLIST VARPTR(tags&(0)),_
  87.         PM_Title&,    SADD("Plain Simple Menu!"+CHR$(0)), _
  88.         PM_NoSelect&, TRUE&, _
  89.         PM_ShinePen&, TRUE&, _
  90.         PM_Shadowed&, TRUE&, _
  91.         PM_Center&,   TRUE&, _
  92.         TAG_DONE&
  93.  
  94.     ii&(1) = PM_MakeItemA&(VARPTR(tags&(0)))
  95.  
  96.     '     Third menu item (separator bar)
  97.     ' Tercer ítem del menú (barra separadora)
  98.     ' ---------------------------------------
  99.     TAGLIST VARPTR(tags&(0)),_
  100.         PM_WideTitleBar&, TRUE&,_
  101.         TAG_DONE&
  102.  
  103.     ii&(2) = PM_MakeItemA&(VARPTR(tags&(0)))
  104.  
  105.  
  106.     ' ----- The other menu entries -----
  107.     ' ------- Restantes entradas -------
  108.     ' ----------------------------------
  109.  
  110.     '   Fourth menu item
  111.     ' Cuarto ítem del menú
  112.     ' --------------------
  113.     TAGLIST VARPTR(tags&(0)), _
  114.         PM_Title&,   SADD("Enable quit?"+CHR$(0)),_
  115.         PM_ID&,      10&,_
  116.         PM_Checkit&, TRUE&,_
  117.         TAG_DONE&
  118.  
  119.     ii&(3) = PM_MakeItemA&(VARPTR(tags&(0)))
  120.  
  121.     '    Fifth menu item (separator menu)
  122.     ' Quinto ítem del menú (barra separadora)
  123.     ' ---------------------------------------
  124.     TAGLIST VARPTR(tags&(0)), _
  125.         PM_TitleBar&, TRUE&, _
  126.         TAG_DONE&
  127.  
  128.     ii&(4) = PM_MakeItemA&(VARPTR(tags&(0)))
  129.  
  130.     '   Last menu item (but firstly, I create your subitem ;)
  131.     ' Último ítem del menú (pero primero, se crea su subítem ;)
  132.     ' ---------------------------------------------------------
  133.  
  134.     TAGLIST VARPTR(tags&(0)), _
  135.         PM_Title&,    SADD("Quit"+CHR$(0)), _
  136.         PM_Disabled&, TRUE&, _
  137.         PM_UserData&, 5&, _
  138.         PM_ID&,       15&, _
  139.         PMEnd&
  140.  
  141.     ii&(5) = PM_MakeItemA&(VARPTR(tags&(0)))
  142.  
  143.     TAGLIST VARPTR(tags&(0)), _
  144.         PM_Title&, SADD("Quit"+CHR$(0)), _
  145.         PM_Sub&,   ii&(5), _
  146.         TAG_DONE&
  147.  
  148.     ii&(6) = PM_MakeItemA&(VARPTR(tags&(0)))
  149.  
  150.     '  Creating the popup menu
  151.     ' Creando el menú emergente
  152.     ' -------------------------
  153.  
  154.     TAGLIST VARPTR(tags&(0)), _
  155.         PM_Item&,ii&(0), _
  156.         PM_Item&,ii&(1), _
  157.         PM_Item&,ii&(2), _
  158.         PM_Item&,ii&(3), _
  159.         PM_Item&,ii&(4), _
  160.         PM_Item&,ii&(6), _
  161.         TAG_DONE&
  162.  
  163.     p& = PM_MakeMenuA&(VARPTR(tags&(0)))
  164.  
  165.     IF p& <> NULL& THEN
  166.  
  167.         '   Window properties
  168.         ' Atributos de la ventana
  169.         ' -----------------------
  170.         TAGLIST VARPTR(tags&(0)),_
  171.             WA_IDCMP&,       IDCMP_CLOSEWINDOW& OR IDCMP_MOUSEBUTTONS&, _
  172.             WA_RMBTrap&,     TRUE&, _
  173.             WA_DragBar&,     TRUE&, _
  174.             WA_Width&,       150, _
  175.             WA_Height&,      100, _
  176.             WA_Left&,        0, _
  177.             WA_Top&,         0, _
  178.             WA_Title&,       SADD("Disable & Enable"+CHR$(0)), _
  179.             WA_CloseGadget&, TRUE&,_
  180.             TAG_DONE&
  181.  
  182.         '  Opening the window: this is only needed for to obtain
  183.         '      some info (font, screen, window position etc).
  184.         ' Abriendo la ventana: ésta sólo es necesaria para obtener
  185.         '    cierta información (tipografía a utilizar, pantalla
  186.         '  sobre la que abrir el menú, posición de la ventana...).
  187.         ' ---------------------------------------------------------
  188.         w& = OpenWindowTagList&(NULL&, VARPTR(tags&(0)))
  189.  
  190.         IF w& <> NULL& THEN
  191.  
  192.             '  First, a C struct simulation (see the imsg var in original C code)
  193.             '      Primero, reservo espacio para simular una estructura en C
  194.             ' (consulte la función de la variable imsg en el código original en C)
  195.             ' --------------------------------------------------------------------
  196.             imsg$=STRING$(IntuiMessage_sizeof%,CHR$(0))
  197.  
  198.             '     Disabling Basic events :)
  199.             ' Desactivando eventos del Basic :)
  200.             ' ---------------------------------
  201.             REM $event OFF
  202.  
  203.             WHILE r&
  204.  
  205.                 '  Waiting a message (you
  206.                 ' can forget the tmp& value).
  207.                 ' Esperando un mensaje (puede
  208.                 '  olvidar el valor de tmp&).
  209.                 ' ---------------------------
  210.                 tmp& = WaitPort&(PEEKL(w&+UserPort%))
  211.  
  212.                 DO
  213.  
  214.                     '    Get the message
  215.                     ' Se obtiene el mensaje
  216.                     ' ---------------------
  217.                     im& = GetMsg&(PEEKL(w&+UserPort%))
  218.                     IF im& THEN
  219.  
  220.                         '   ... but we will work with a copy
  221.                         ' ... pero se trabajará con una copia
  222.                         ' -----------------------------------
  223.                         CopyMem im&, SADD(imsg$), IntuiMessage_sizeof%
  224.                         ReplyMsg im&
  225.  
  226.                         '        Reusing the tmp& var ;)
  227.                         ' Reutilización de la variable tmp& ;)
  228.                         ' ------------------------------------
  229.                         tmp& = PEEKL(SADD(imsg$)+Class%)
  230.  
  231.                         SELECT CASE tmp&
  232.  
  233.                                 CASE = IDCMP_CLOSEWINDOW&
  234.                                     r& = FALSE&
  235.                                     EXIT DO
  236.  
  237.                                 CASE = IDCMP_MOUSEBUTTONS&
  238.  
  239.  
  240.                                     ' The 9.03 documentation signals what the PM_Code& tag is obsoleted!
  241.                                     '     Deleted the entry PM_Code& (well, changed for PM_Dummy&).
  242.                                     '         ¡La documentación de la versión 9.03 indica que
  243.                                     '             la etiqueta PM_Code& ha quedado obsoleta!
  244.                                     '    Suprimida la entrada PM_Code& (bueno, cambiada por PM_Dummy&)
  245.                                     ' ------------------------------------------------------------------
  246.                                     TAGLIST VARPTR(tags&(0)), _
  247.                                         PM_Menu&,  p&, _
  248.                                         PM_Dummy&, (SADD(imsg$)+IntuiMessageCode%), _
  249.                                         TAG_DONE&
  250.  
  251.                                     '  Opening finally my popupmenu menu
  252.                                     ' Abriendo finalmente mi menú emergente
  253.                                     ' -------------------------------------
  254.                                     r& = PM_OpenPopupMenuA&(w&, VARPTR(tags&(0))) - 5&
  255.  
  256.                                     IF PM_ItemChecked(p&,10&) THEN
  257.  
  258.                                         ' Enabling the Quit submenu
  259.                                         ' Activando el submenú Quit
  260.                                         ' -------------------------
  261.                                         TAGLIST VARPTR(tags&(0)), _
  262.                                             PM_Disabled&, FALSE&, _
  263.                                             TAG_DONE&
  264.  
  265.                                         dummy& = PM_SetItemAttrsA&(PM_FindItem&(p&,15&), VARPTR(tags&(0)))
  266.  
  267.                                     ELSE
  268.  
  269.  
  270.                                         '  Disabling the Quit submenu
  271.                                         ' Desactivando el submenú Quit
  272.                                         ' ----------------------------
  273.                                         TAGLIST VARPTR(tags&(0)), _
  274.                                             PM_Disabled&, TRUE&, _
  275.                                             TAG_DONE&
  276.  
  277.                                         dummy& = PM_SetItemAttrsA&(PM_FindItem&(p&,15&), VARPTR(tags&(0)))
  278.  
  279.                                     END IF
  280.  
  281.                                     EXIT DO
  282.  
  283.                         END SELECT
  284.  
  285.                     ELSE
  286.  
  287.                         EXIT LOOP
  288.  
  289.                     END IF
  290.  
  291.                 LOOP
  292.  
  293.             WEND
  294.  
  295.             '    Reenabling Basic events :)
  296.             ' Reactivando eventos del Basic :)
  297.             ' --------------------------------
  298.             REM $event ON
  299.  
  300.             CloseWindow& w&
  301.  
  302.         ELSE
  303.  
  304.             PRINT "Window error!"
  305.  
  306.         END IF
  307.  
  308.         PM_FreePopupMenu& p&
  309.  
  310.     ELSE
  311.  
  312.         PRINT "Menu error!"
  313.  
  314.     END IF
  315.  
  316. ELSE
  317.  
  318.     PRINT "One or more libraries have failed!"
  319.  
  320. END IF
  321.  
  322.  
  323. IF gb&  <> NULL& THEN LIBRARY VARPTR "graphics.library",  NULL&
  324. IF ib&  <> NULL& THEN LIBRARY VARPTR "intuition.library", NULL&
  325.  
  326. LIBRARY CLOSE
  327.  
  328. END
  329.  
  330.