home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Exec 5 / CD_Magazyn_EXEC_nr_5.iso / Programy / Programowanie / BASIC / pmDevBas.lha / Layout.bas < prev    next >
Encoding:
BASIC Source File  |  2000-06-12  |  11.4 KB  |  449 lines
  1. ' *********************************************************************
  2. '             Layout © Henrik Isaksson -- All Rights Reserved
  3. '                           V. 1.1 (23.08.00)
  4. '
  5. '                 C to HBASIC conversion 1.0a (12.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 groups like the C version...
  10. '      except what with this version };) the Quit item works.
  11. '
  12. '           Este ejemplo muestra cómo crear grupos igual que
  13. '                 en la versión en C... salvo que con
  14. '           esta versión };) el ítem Quit (Salir) funciona.
  15. ' *********************************************************************
  16.  
  17. REM $include pm.bh
  18. REM $include exec.bh
  19. REM $include intuition.bh
  20. REM $include utility.bc
  21.  
  22. pmb&  = NULL&    ' PopUpMenuBase
  23. ib&   = NULL&    ' IntuitionBase
  24. gb&   = NULL&    ' GfxBase
  25. w&    = NULL&    ' Window
  26. im&   = NULL&    ' IntuiMessage
  27. p&    = NULL&    ' PopupMenu
  28. r&    = TRUE&    ' Status flag (loop) / Bandera de estado (bucle)
  29. ok&   = FALSE&   ' Status flag / Bandera de estado
  30.  
  31. DIM wtags&(20)   ' Window Taglist / Lista de atributos para la ventana
  32.  
  33. ' My function / Mi función
  34. ' ------------------------
  35. DECLARE FUNCTION MakeTestMenu&()
  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.         gb& = PEEKL(pmb& + pmb_GfxBase%)
  56.         IF gb& <> NULL& THEN
  57.             LIBRARY VARPTR "graphics.library", gb&
  58.             ok& = TRUE&
  59.         END IF
  60.     END IF
  61. END IF
  62.  
  63. IF ok& = TRUE& THEN
  64.  
  65.     ' Preparing my menu / Preparando mi menú
  66.     ' --------------------------------------
  67.     p& = MakeTestMenu&()
  68.  
  69.     IF p& <> NULL& THEN
  70.  
  71.         '   Window properties
  72.         ' Atributos de la ventana
  73.         ' -----------------------
  74.         TAGLIST VARPTR(wtags&(0)),_
  75.             WA_IDCMP&,       IDCMP_CLOSEWINDOW& OR IDCMP_MOUSEBUTTONS& OR IDCMP_VANILLAKEY, _
  76.             WA_RMBTrap&,     TRUE&, _
  77.             WA_DragBar&,     TRUE&, _
  78.             WA_Width&,       150, _
  79.             WA_Height&,      100, _
  80.             WA_Left&,        0, _
  81.             WA_Top&,         100, _
  82.             WA_Title&,       SADD("Layout"+CHR$(0)), _
  83.             WA_CloseGadget&, TRUE&,_
  84.             TAG_DONE&
  85.  
  86.         '    Opening the window: this window is only needed to find out
  87.         '  when AND where the MENU should appear AND wich SCREEN it's on.
  88.         ' Abriendo la ventana: sólo es necesaria para saber dónde y cuándo
  89.         '       el menú emergente debe aparecer y sobre qué pantalla.
  90.         ' ----------------------------------------------------------------
  91.         w& = OpenWindowTagList&(NULL&, VARPTR(wtags&(0)))
  92.  
  93.         IF w& <> NULL& THEN
  94.  
  95.             '  First, a C struct simulation (see the imsg var in original C code)
  96.             '      Primero, reservo espacio para simular una estructura en C
  97.             ' (consulte la función de la variable imsg en el código original en C)
  98.             ' --------------------------------------------------------------------
  99.             imsg$=STRING$(IntuiMessage_sizeof%,CHR$(0))
  100.  
  101.             '     Disabling Basic events :)
  102.             ' Desactivando eventos del Basic :)
  103.             ' ---------------------------------
  104.             REM $event OFF
  105.  
  106.             WHILE r&
  107.  
  108.                 '  Waiting a message
  109.                 ' Esperando un mensaje
  110.                 ' --------------------
  111.                 dummy& = WaitPort&(PEEKL(w&+UserPort%))
  112.  
  113.                 DO
  114.  
  115.                     '    Get the message
  116.                     ' Se obtiene el mensaje
  117.                     ' ---------------------
  118.                     im& = GetMsg&(PEEKL(w&+UserPort%))
  119.                     IF im& THEN
  120.  
  121.                         '   ... but we will work with a copy
  122.                         ' ... pero se trabajará con una copia
  123.                         ' -----------------------------------
  124.                         CopyMem im&, SADD(imsg$), IntuiMessage_sizeof%
  125.                         ReplyMsg im&
  126.  
  127.                         tmp& = PEEKL(SADD(imsg$)+Class%)
  128.  
  129.                         SELECT CASE tmp&
  130.  
  131.                                 CASE = IDCMP_MOUSEBUTTONS&
  132.  
  133.                                     TAGLIST VARPTR(tags&(0)), _
  134.                                         PM_Menu&,  p&, _
  135.                                         TAG_DONE&
  136.  
  137.                                     '  Opening finally my popupmenu menu
  138.                                     ' Abriendo finalmente mi menú emergente
  139.                                     ' -------------------------------------
  140.                                     r& = PM_OpenPopupMenuA&(w&, VARPTR(tags&(0))) - 2&
  141.  
  142.                                     EXIT DO
  143.  
  144.                                 CASE = IDCMP_CLOSEWINDOW&
  145.                                     r& = FALSE&
  146.                                     EXIT DO
  147.  
  148.                         END SELECT
  149.  
  150.                     ELSE
  151.  
  152.                         EXIT LOOP
  153.  
  154.                     END IF
  155.  
  156.                 LOOP
  157.  
  158.             WEND
  159.  
  160.             '    Reenabling Basic events :)
  161.             ' Reactivando eventos del Basic :)
  162.             ' --------------------------------
  163.             REM $event ON
  164.  
  165.             CloseWindow& w&
  166.  
  167.         ELSE
  168.  
  169.             PRINT "Window error!"
  170.  
  171.         END IF
  172.  
  173.         PM_FreePopupMenu& p&
  174.  
  175.     ELSE
  176.  
  177.         PRINT "Menu error!"
  178.  
  179.     END IF
  180.  
  181. ELSE
  182.  
  183.     PRINT "One or more libraries have failed!"
  184.  
  185. END IF
  186.  
  187. IF gb&  <> NULL& THEN LIBRARY VARPTR "graphics.library",  NULL&
  188. IF ib&  <> NULL& THEN LIBRARY VARPTR "intuition.library", NULL&
  189.  
  190. '          Safe, even if the program fails to open the libraries
  191. ' Método seguro, incluso aunque el programa falle al abrir las bibliotecas
  192. ' ------------------------------------------------------------------------
  193. LIBRARY CLOSE "popupmenu.library"
  194. LIBRARY CLOSE "exec.library"
  195.  
  196. END
  197.  
  198. ' =====================================================================
  199.  
  200. FUNCTION MakeTestMenu&()
  201. LOCAL i&,j&,pi1&,pi2&,mpi&,tags&
  202.  
  203. ' Taglist / Lista de atributos
  204. ' ----------------------------
  205. DIM tags&(28)
  206.  
  207. ' Items or menu pointer arrays / Matrices de punteros a ítems o menús
  208. ' -------------------------------------------------------------------
  209. DIM mpi&(7)     ' Main
  210. DIM pi1&(10)    ' Aux. first  level
  211. DIM pi2&(9)     ' Aux. second level
  212.  
  213.     ' ====================================
  214.     '     Menu header (PMMenu macro)
  215.     '   Cabecera del menú (macro PMMenu)
  216.     ' =====================================
  217.  
  218.     '   First menu item (not visible)
  219.     ' Primer ítem del menú (no visible)
  220.     ' ---------------------------------
  221.     TAGLIST VARPTR(tags&(0)), _
  222.         PM_Hidden&, TRUE&, _
  223.         TAG_DONE&
  224.  
  225.     mpi&(0) = PM_MakeItemA&(VARPTR(tags&(0)))
  226.  
  227.     '    Second menu item (title)
  228.     ' Segundo ítem del menú (título)
  229.     ' ------------------------------
  230.     TAGLIST VARPTR(tags&(0)),_
  231.         PM_Title&,SADD("Group Layout"+CHR$(0)), _
  232.         PM_NoSelect&, TRUE&, _
  233.         PM_ShinePen&, TRUE&, _
  234.         PM_Shadowed&, TRUE&, _
  235.         PM_Center&,   TRUE&, _
  236.         TAG_DONE&
  237.  
  238.     mpi&(1) = PM_MakeItemA&(VARPTR(tags&(0)))
  239.  
  240.     '     Third menu item (separator bar)
  241.     ' Tercer ítem del menú (barra separadora)
  242.     ' ---------------------------------------
  243.     TAGLIST VARPTR(tags&(0)), _
  244.         PM_WideTitleBar&, TRUE&, _
  245.         TAG_DONE&
  246.  
  247.     mpi&(2) = PM_MakeItemA&(VARPTR(tags&(0)))
  248.  
  249.     ' ===================================================================
  250.     ' The first horizontal group with three elements (one is other group)
  251.     ' El primer grupo horizontal con tres elementos (one is other group)
  252.     ' ===================================================================
  253.  
  254.     ' -------------------------------
  255.     ' First element / Primer elemento
  256.     '--------------------------------
  257.  
  258.     TAGLIST VARPTR (tags&(0)),_
  259.         PM_Title&,  SADD("Left"+CHR$(0)),_
  260.         PM_Center&, TRUE&,_
  261.         TAG_DONE&
  262.  
  263.     pi1&(1)= PM_MakeItemA&(VARPTR(tags&(0)))
  264.  
  265.     ' ------------------------------------
  266.     '  Second element (a vertical group)
  267.     ' Segundo elemento (un grupo vertical)
  268.     ' ------------------------------------
  269.  
  270.     FOR i&=1 TO 6
  271.  
  272.         ' Creating the six menu entries / Creando seis entradas de menú
  273.         ' -------------------------------------------------------------
  274.  
  275.         TAGLIST VARPTR (tags&(0)),_
  276.             PM_Title&,  SADD("Item"+RIGHT$(STR$(i&),LEN(STR$(i&))-1)++CHR$(0)),_
  277.             PM_Center&, TRUE&,_
  278.             TAG_DONE&
  279.  
  280.         pi2&(i&)= PM_MakeItemA&(VARPTR(tags&(0)))
  281.  
  282.     NEXT i&
  283.  
  284.     ' Now, vertical grouping... / Ahora, agrupación vertical...
  285.     ' ---------------------------------------------------------
  286.     TAGLIST VARPTR(tags&(0)),_
  287.         PM_Dummy&, 0&,_
  288.         PM_Item&,  pi2&(1), _
  289.         PM_Item&,  pi2&(2), _
  290.         PM_Item&,  pi2&(3), _
  291.         PM_Item&,  pi2&(4), _
  292.         PM_Item&,  pi2&(5), _
  293.         PM_Item&,  pi2&(6), _
  294.         TAG_DONE&
  295.  
  296.     pi2&(0) = PM_MakeMenuA&(VARPTR(tags&(0)))
  297.  
  298.     TAGLIST VARPTR(tags&(0)), _
  299.         PM_NoSelect&,   TRUE&, _
  300.         PM_LayoutMode&, PML_Vertical&, _
  301.         PM_Members&,    pi2&(0),_
  302.         TAG_DONE&
  303.  
  304.     pi1&(2) = PM_MakeItemA&(VARPTR(tags&(0)))
  305.  
  306.     ' -------------------------------
  307.     ' Third element / Tercer elemento
  308.     ' -------------------------------
  309.  
  310.     TAGLIST VARPTR (tags&(0)),_
  311.         PM_Title&,   SADD("Right"+CHR$(0)),_
  312.         PM_Center&, TRUE&,_
  313.         TAG_DONE&
  314.  
  315.     pi1&(3)= PM_MakeItemA&(VARPTR(tags&(0)))
  316.  
  317.     '  And now, horizontal grouping...
  318.     ' Y ahora, agrupación horizontal...
  319.     ' ---------------------------------
  320.     TAGLIST VARPTR(tags&(0)),_
  321.         PM_Dummy&, 0&,_
  322.         PM_Item&,  pi1&(1), _
  323.         PM_Item&,  pi1&(2), _
  324.         PM_Item&,  pi1&(3), _
  325.         TAG_DONE&
  326.  
  327.     pi1&(0) = PM_MakeMenuA&(VARPTR(tags&(0)))
  328.  
  329.     TAGLIST VARPTR(tags&(0)), _
  330.         PM_NoSelect&,   TRUE&, _
  331.         PM_LayoutMode&, PML_Horizontal&, _
  332.         PM_Members&,    pi1&(0),_
  333.         TAG_DONE&
  334.  
  335.     mpi&(3) = PM_MakeItemA&(VARPTR(tags&(0)))
  336.  
  337.     ' ================================
  338.     ' Separator bar / Barra separadora
  339.     ' ================================
  340.     TAGLIST VARPTR(tags&(0)), _
  341.         PM_TitleBar&, TRUE&, _
  342.         TAG_DONE&
  343.  
  344.     mpi&(4) = PM_MakeItemA&(VARPTR(tags&(0)))
  345.  
  346.     ' ====================================================
  347.     '   The second group (vertical)... this contains
  348.     '   five entries (horizontal groups with 10 items).
  349.     '   El segundo grupo (vertical)... contiene cinco
  350.     ' entradas (grupos horizontales de 10 ítems cada uno).
  351.     ' ====================================================
  352.  
  353.     FOR j& = 0 TO 4                        '  5 items (vertical)
  354.  
  355.         FOR i& = 0  TO 9                ' 10 items (horizontal)
  356.  
  357.             TAGLIST VARPTR (tags&(0)),_
  358.                 PM_ColourBox&, i&+(j&*10),_
  359.                 TAG_DONE&
  360.  
  361.             pi2&(i&)= PM_MakeItemA&(VARPTR(tags&(0)))
  362.  
  363.         NEXT i&
  364.  
  365.     ' Creating the horizontal group / Creación del grupo horizontal
  366.     ' -------------------------------------------------------------
  367.  
  368.         TAGLIST VARPTR(tags&(0)),_
  369.             PM_Dummy&, 0&,_
  370.             PM_Item&,  pi2&(1), _
  371.             PM_Item&,  pi2&(2), _
  372.             PM_Item&,  pi2&(3), _
  373.             PM_Item&,  pi2&(4), _
  374.             PM_Item&,  pi2&(5), _
  375.             PM_Item&,  pi2&(6), _
  376.             PM_Item&,  pi2&(7), _
  377.             PM_Item&,  pi2&(8), _
  378.             PM_Item&,  pi2&(9), _
  379.             PM_Item&,  pi2&(0), _
  380.             TAG_DONE&
  381.  
  382.         pi1&(6+j&) = PM_MakeMenuA&(VARPTR(tags&(0)))
  383.  
  384.         TAGLIST VARPTR(tags&(0)), _
  385.             PM_NoSelect&,   TRUE&, _
  386.             PM_LayoutMode&, PML_Horizontal&, _
  387.             PM_Members&,    pi1&(6+j&),_
  388.             TAG_DONE&
  389.  
  390.         pi1&(1+j&) = PM_MakeItemA&(VARPTR(tags&(0)))
  391.  
  392.     NEXT j&
  393.  
  394.     ' Creating the vertical group / Creación del grupo vertical
  395.     ' ---------------------------------------------------------
  396.     TAGLIST VARPTR(tags&(0)),_
  397.         PM_Dummy&, 0&,_
  398.         PM_Item&,  pi1&(1), _
  399.         PM_Item&,  pi1&(2), _
  400.         PM_Item&,  pi1&(3), _
  401.         PM_Item&,  pi1&(4), _
  402.         PM_Item&,  pi1&(5), _
  403.         TAG_DONE&
  404.  
  405.     pi1&(0) = PM_MakeMenuA&(VARPTR(tags&(0)))
  406.  
  407.     TAGLIST VARPTR(tags&(0)), _
  408.         PM_NoSelect&,   TRUE&, _
  409.         PM_LayoutMode&, PML_Vertical&, _
  410.         PM_Members&,    pi1&(0),_
  411.         TAG_DONE&
  412.  
  413.     mpi&(5) = PM_MakeItemA&(VARPTR(tags&(0)))
  414.  
  415.     ' ================================
  416.     ' Separator bar / Barra separadora
  417.     ' ================================
  418.     TAGLIST VARPTR(tags&(0)), _
  419.         PM_TitleBar&, TRUE&, _
  420.         TAG_DONE&
  421.  
  422.     mpi&(6) = PM_MakeItemA&(VARPTR(tags&(0)))
  423.  
  424.     ' =============================
  425.     ' Quit item / Ítem Quit (Salir)
  426.     ' =============================
  427.  
  428.     TAGLIST VARPTR(tags&(0)), _
  429.         PM_Title&,    SADD("Quit"+CHR$(0)), _
  430.         PM_UserData&, 2&, _
  431.         TAG_DONE&
  432.  
  433.     mpi&(7) = PM_MakeItemA&(VARPTR(tags&(0)))
  434.  
  435.     ' =========================
  436.     '  Creating the popup menu
  437.     ' Creando el menú emergente
  438.     ' =========================
  439.  
  440.     FOR i& = 0 TO 7
  441.         TAGLIST VARPTR(tags&(i&*2)), _
  442.             PM_Item&, mpi&(i&), _
  443.             TAG_DONE&
  444.     NEXT i&
  445.  
  446.     MakeTestMenu& = PM_MakeMenuA&(VARPTR(tags&(0)))
  447.  
  448. END FUNCTION
  449.