W Pub: ABAP Prog Propios ZM 00 SMENU

  1. ************************************************************************
  2. *  Programa: ZM00SMENU                                                 *
  3. *  Autor   : S2D                                                       *
  4. *  Fecha   : 02-01-01/[Desconocida]                                    *
  5. ************************************************************************
  6. *   Este cdigo fuente no necesita ser actualizado. Tal vez reparado,  *
  7. *   pero no actualizado.                                               *
  8. *                                                                      *
  9. *   Cuando se quiera  crear un  men nuevo, simplemente  se crea una   *
  10. *   superficie. Para que quede ms  bonito se puede  crear un ttulo   *
  11. *   con el mismo nombre que la superficie.                             *
  12. *                                                                      *
  13. *   Existe  una  forma  de  ir directamente a  una superficie con la   *
  14. *   variable.                                                          *
  15. *   RUNME donde pondremos la superficie inicial. Por defecto 'ZM00'.   *
  16. *   Es posible adaptarlo para que arranque con la standard MEN, pero   *
  17. *   habra que diseñarla.                                              *
  18. *   Tambin se puede utilizar la variable  de parametros de usuarios   *
  19. *   ZRUNMENU pasandole la superficie que quieras iniciar               *
  20. *                                                                      *
  21. *   Actualmente este report  trabaja  con una dynpro,  pero tambin    *
  22. *   puede ejecutarse como report. Obteniendo otros resultados.         *
  23. ************************************************************************
  24.  
  25. report zm00smenu no standard page heading.
  26.  
  27. * Tablas necesarias para recuperar superficies y funciones.
  28. tables: eudb, tstc.
  29.  
  30. * Datos internos de programa
  31. data:
  32. begin of tab occurs 10,
  33.   fcode like rsmpe-func,
  34. end of tab,
  35.  
  36. pila(20) occurs 0 with header line,
  37.  
  38. begin of sitab occurs 0,
  39.   code(20),
  40.   modal(01),
  41.   actcode(20),
  42.   pfkcode(20),
  43.   butcode(4),
  44. end of sitab,
  45.  
  46. begin of nameprg,
  47.   name(40),
  48.   sprls(1),
  49. end of nameprg,
  50. int_fun     like rsmpe_fun  occurs 0 with header line,
  51. runme(20),
  52. onetime(1),
  53. pilai type p,
  54. aplica(1),
  55. caracter(20).
  56.  
  57. at user-command.
  58. * Preparado para convertirse en report...
  59.    perform selecion.
  60. end-of-selection.
  61.    perform bout2.
  62.  
  63. form selecion.
  64. * Refresh tab.
  65. * Cmp si lo que se nos ha pulsado es un Status.
  66.    loop at sitab where code = sy-ucomm. exit. endloop.
  67. * Es otro men de superficie
  68.    if sy-ucomm = 'BACK'.
  69. ************************************************************************
  70. **      OK! OK! El BACK Se podra haber solucionado de otra forma.    **
  71. ************************************************************************
  72.       describe table pila lines pilai.
  73.       pilai = pilai - 1.
  74.       if pilai <= 0.
  75.          leave program.
  76.       endif.
  77.       read table pila index pilai.
  78.       sy-ucomm = pila.
  79.       pilai = pilai + 1. delete pila index pilai.
  80.       pilai = pilai - 1. delete pila index pilai.
  81.       clear sy-subrc.
  82.     endif.
  83.    if sy-subrc = '0'.
  84.       runme = sy-ucomm.
  85.      perform pon_status using sy-ucomm.
  86.    else.
  87. * Es una transaccin.
  88.       select single * from tstc where tcode = sy-ucomm.
  89.       check sy-subrc eq 0.
  90. *      BREAK-POINT.
  91. * Realmente es una transaccin
  92.       if tstc-cinfo ne '01'.
  93.         call transaction sy-ucomm.
  94. * Es un men de ambito.
  95.       else.
  96.         leave to transaction sy-ucomm.
  97.       endif.
  98.     endif.
  99. endform.
  100.  
  101. form bout2.
  102. data: xrunme like runme.
  103.   if onetime = ' '.
  104.   include zmin0000.
  105. * Si existe parmetro, llamamos directamente.
  106.   get parameter id 'ZRUNME' field runme.
  107. * En RunMe estar el programa de inicio.
  108.   if runme is initial. runme = 'ZM00'. endif.
  109.   get parameter id 'ZRUNMENU' field xrunme.
  110.   if xrunme is initial and runme is initial. runme = 'ZM00'. endif.
  111. * Dejamos en memoria el identificativo para el aplicativo MARES.
  112.   call function 'Z_GET_PARAMETER_APLICA'
  113.       importing
  114.            d_aplica = aplica
  115.        exceptions
  116.             others   = 1.
  117.   if aplica is initial.
  118.      set parameter id 'ZID_APLICA' field ' '.
  119.      call function 'Z_SET_PARAMETER_APLICA'
  120.        exporting
  121.             d_aplica = 'M'.
  122.    endif.
  123. *Forzamos a la creacin del aplicativo...
  124.    if xrunme+0(3) = 'ZMC' or runme+0(3) = 'ZMC'.
  125.       set parameter id 'ZID_APLICA' field ' '.
  126.       call function 'Z_SET_PARAMETER_APLICA'
  127.         exporting
  128.             d_aplica = 'C'.
  129.    else.
  130.       set parameter id 'ZID_APLICA' field ' '.
  131.       call function 'Z_SET_PARAMETER_APLICA'
  132.         exporting
  133.             d_aplica = 'M'.
  134.    endif.
  135. * Obtenemos los status asociados a nuestro programa.
  136.    nameprg-name = sy-repid. nameprg-sprls = 'D'.
  137. * Cargamos todas las funciones y todos los status
  138.    import sta to sitab from database eudb(cu) id nameprg.
  139.    import fun to int_fun from database eudb(cu) id nameprg.
  140. * Comprobamos la existencia de los status y las funciones.
  141.    loop at int_fun.
  142.       select single * from tstc where tcode = int_fun-code.
  143.       check int_fun-code+0(1) ne '%'.
  144.       check int_fun-code ne 'BACK'.
  145.       check int_fun-code ne 'CANC'.
  146. * No vamos a permitir menus de superficie.
  147.       if sy-subrc ne 0 or ( sy-subrc = 0 and tstc-cinfo = '01' ) or
  148.          int_fun-code = 'ZMZZ'.
  149.          read table sitab with key code = int_fun-code.
  150.          if sy-subrc ne 0 or int_fun-code = 'ZMZZ'.
  151.             read table tab with key fcode = int_fun-code.
  152.             if sy-subrc ne 0.
  153. * Desactivamos las funciones no vlidas
  154.                append int_fun-code to tab.
  155.             else.
  156.                perform seguridad. check sy-subrc ne 0.
  157.                append int_fun-code to tab.
  158.             endif.
  159.          else.
  160.             perform seguridad. check sy-subrc ne 0.
  161.             append int_fun-code to tab.
  162.          endif.
  163.       else.
  164.          perform seguridad. check sy-subrc ne 0.
  165.          append int_fun-code to tab.
  166.       endif.
  167.    endloop.
  168. * Primer Status
  169.    endif.
  170.    onetime = 'X'.
  171.    perform pon_status using runme.
  172. endform.
  173.  
  174. form pon_status using sycode.
  175. set pf-status sycode excluding tab.
  176. set titlebar sycode.
  177. if sy-subrc ne 0.
  178.    set titlebar sy-repid. endif
  179. .
  180. pila = sycode.
  181. collect pila.
  182. runme = sycode.
  183. write: ' '.
  184. endform.
  185.  
  186. form seguridad.
  187.   authority-check object 'S_TCODE' id 'TCD' field int_fun-code+0(10).
  188. endform.
  189.  
  190. module bin input. perform selecion. endmodule.
  191. module bout output. perform bout2. endmodule.
[$[Get Code]]