Ver Mensaje Individual
  #3  
Viejo 25/01/08, 16:00:31
fcorodriguezl fcorodriguezl is offline
Junior Member
 
Fecha de Ingreso: jul 2007
Mensajes: 22
este es el codigo del prog. En rojo pongo donde me da el error.
Gracias


*----------------------------------------------------------------------*
* INCLUDE Z_DISPLAY_TABLE
*----------------------------------------------------------------------*
* Display ANY table by reference
* Table must be defined with TYPE statement (object oriented)
*
* HOW TO USE
* - include this program into your program (data definition part)
* - CALL METHOD lcl_table_display=>display_list or display_grid
* EXPORTING data = yourinternaltable
*
*----------------------------------------------------------------------*
* Author: François Henrotte (EPONA Solutions)
* Site:
*----------------------------------------------------------------------*


*----------------------------------------------------------------------*
* LCL_TABLE_DISPLAY DEFINITION
*----------------------------------------------------------------------*
CLASS lcl_table_display DEFINITION.

PUBLIC SECTION.

TYPE-POOLS: abap, slis.

CLASS-METHODS: display_list IMPORTING in_data TYPE STANDARD TABLE,
display_grid IMPORTING in_data TYPE STANDARD TABLE.

METHODS: constructor IMPORTING in_data TYPE STANDARD TABLE
EXCEPTIONS casting_error
empty_fieldcat.

METHODS: output_list,
output_grid.

METHODS: set_table_name IMPORTING in_tabname TYPE any,
set_alv_title IMPORTING in_title TYPE any,
set_alv_settings IMPORTING in_settings TYPE any,
set_alv_layout IMPORTING in_layout TYPE any,
set_alv_event IMPORTING in_name TYPE any
in_form TYPE any.


PRIVATE SECTION.

CLASS-DATA: g_table_object TYPE REF TO lcl_table_display.

TYPES: BEGIN OF ty_defin,
fieldname TYPE fieldname,
ref_tabname TYPE tabname,
ref_fieldname TYPE fieldname,
END OF ty_defin.

DATA: g_repid TYPE repid,
g_struc TYPE tabname,
g_table TYPE tabname.

DATA: gt_data TYPE REF TO data.

DATA: g_title TYPE lvc_title,
gt_fcat TYPE slis_t_fieldcat_alv,
gs_sett TYPE lvc_s_glay,
gs_layo TYPE slis_layout_alv,
gt_evnt TYPE slis_t_event.

DATA: gt_defin TYPE TABLE OF ty_defin,
g_level TYPE tabname.


METHODS: output_table IMPORTING data TYPE REF TO data
mode TYPE c,

fill_fieldcat IMPORTING repid TYPE repid
struc TYPE tabname
CHANGING fcat TYPE slis_t_fieldcat_alv
EXCEPTIONS no_definition,
get_definition IMPORTING repid TYPE repid
struc TYPE tabname
CHANGING abap TYPE rsfb_source,
recursive_definition IMPORTING repid TYPE repid
CHANGING abap TYPE rsfb_source,

map_structure IMPORTING source TYPE any
CHANGING destin TYPE any.
ENDCLASS.


*----------------------------------------------------------------------*
* LCL_TABLE_DISPLAY IMPLEMENTATION
*----------------------------------------------------------------------*
CLASS lcl_table_display IMPLEMENTATION.
***
* Display table in ALV list
***
METHOD display_list.
IF NOT g_table_object IS INITIAL.
FREE: g_table_object.
ENDIF.
CREATE OBJECT g_table_object EXPORTING in_data = in_data.
CALL METHOD g_table_object->output_list.
ENDMETHOD.
***
* Display table in ALV grid
***
METHOD display_grid.
IF NOT g_table_object IS INITIAL.
FREE: g_table_object.
ENDIF.
CREATE OBJECT g_table_object EXPORTING in_data = in_data.
CALL METHOD g_table_object->output_grid.
ENDMETHOD.
***
* Create table display
***
METHOD constructor.
DATA: ls_data TYPE REF TO data.

DATA: ob_desc TYPE REF TO cl_abap_structdescr.

DATA: l_absol TYPE char200,
l_repid TYPE repid,
l_struc TYPE tabname.

FIELD-SYMBOLS: <table> TYPE STANDARD TABLE,
<struc> TYPE ANY.

* Get data and store it into attribute
CREATE DATA me->gt_data LIKE in_data.
ASSIGN me->gt_data->* TO <table>.
<table> = in_data.

* Get global data definition
CREATE DATA ls_data LIKE LINE OF <table>.
ASSIGN ls_data->* TO <struc>.
CATCH SYSTEM-EXCEPTIONS assign_casting_illegal_cast = 1.
ob_desc ?= cl_abap_typedescr=>describe_by_data( <struc> ).
ENDCATCH.
IF sy-subrc = 1.
RAISE casting_error.
ENDIF.

* Get program name and main type used to define table
l_absol = ob_desc->absolute_name.
SPLIT l_absol AT '\TYPE=' INTO l_repid l_struc.
SHIFT l_repid UP TO '='.
SHIFT l_repid.

CHECK l_struc NP '%_*'.

IF me->g_repid NE l_repid
OR me->g_struc NE l_struc.
* Set attributes
me->g_repid = l_repid.
me->g_struc = l_struc.

me->g_table = l_struc.
REPLACE 'TY' WITH 'WT' INTO me->g_table.

* Field catalog
CALL METHOD fill_fieldcat EXPORTING repid = l_repid
struc = l_struc
CHANGING fcat = me->gt_fcat.
IF me->gt_fcat IS INITIAL.
RAISE empty_fieldcat.
ENDIF.
ENDIF.
ENDMETHOD.
***
* Output list
***
METHOD output_list.
CALL METHOD output_table EXPORTING data = me->gt_data
mode = 'L'.
ENDMETHOD.
***
* Output grid
***
METHOD output_grid.
CALL METHOD output_table EXPORTING data = me->gt_data
mode = 'G'.
ENDMETHOD.
***
* Output table
***
METHOD output_table.
DATA: ls_vari TYPE disvariant.

FIELD-SYMBOLS: <table> TYPE STANDARD TABLE.

ASSIGN me->gt_data->* TO <table>.

* Get default user variant
ls_vari-report = me->g_repid.
ls_vari-username = sy-uname.
CALL FUNCTION 'REUSE_ALV_VARIANT_DEFAULT_GET'
EXPORTING
i_save = 'U'
CHANGING
cs_variant = ls_vari
EXCEPTIONS
OTHERS = 0.

* Display table contents
IF mode = 'G'.
CALL FUNCTION 'REUSE_ALV_GRID_DISPLAY'
EXPORTING
i_callback_program = me->g_repid
i_grid_title = me->g_title
i_grid_settings = me->gs_sett
is_layout = me->gs_layo
it_fieldcat = me->gt_fcat
i_save = 'U'
is_variant = ls_vari
it_events = me->gt_evnt
TABLES
t_outtab = <table>
EXCEPTIONS
OTHERS = 0.
ELSE.
CALL FUNCTION 'REUSE_ALV_LIST_DISPLAY'
EXPORTING
i_callback_program = me->g_repid
is_layout = me->gs_layo
it_fieldcat = me->gt_fcat
i_save = 'U'
is_variant = ls_vari
it_events = me->gt_evnt
TABLES
t_outtab = <table>
EXCEPTIONS
OTHERS = 0.
ENDIF.
ENDMETHOD.
***
* Fill field catalog
***
METHOD fill_fieldcat.
DATA: lt_abap TYPE TABLE OF rssource.

DATA: ls_defin TYPE ty_defin.

DATA: lt_dfies TYPE TABLE OF dfies,
ls_dfies TYPE dfies,
ls_dd04v TYPE dd04v,
ls_dd01v TYPE dd01v,
l_flong TYPE dfies-lfieldname,
l_dname TYPE dfies-domname.

DATA: ls_fcat TYPE slis_fieldcat_alv,
ls_fcat2 TYPE slis_fieldcat_alv.

DATA: l_index TYPE i,
l_nbfld TYPE i.

FREE: me->gt_defin.

* Process data definition
CALL METHOD get_definition EXPORTING repid = repid
struc = struc
CHANGING abap = lt_abap.

* Process sub levels if required
CALL METHOD recursive_definition EXPORTING repid = repid
CHANGING abap = lt_abap.

IF me->gt_defin IS INITIAL.
RAISE no_definition.
ENDIF.

LOOP AT me->gt_defin INTO ls_defin.
CLEAR: ls_fcat.
MOVE-CORRESPONDING ls_defin TO ls_fcat.
* Retrieve info about this field
FREE: ls_dfies, ls_dd04v, ls_dd01v, l_dname.
l_flong = ls_fcat-ref_fieldname.
SET LOCALE LANGUAGE 'E'.
TRANSLATE: ls_fcat-ref_tabname TO UPPER CASE,
ls_fcat-ref_fieldname TO UPPER CASE,
l_flong TO UPPER CASE.
IF NOT ls_fcat-ref_tabname IS INITIAL.
* Try to get info about field in table
CALL FUNCTION 'DDIF_FIELDINFO_GET'
EXPORTING
tabname = ls_fcat-ref_tabname
fieldname = ls_fcat-ref_fieldname
lfieldname = l_flong
IMPORTING
dfies_wa = ls_dfies
EXCEPTIONS
not_found = 1
internal_error = 2
OTHERS = 3.
IF sy-subrc = 0.
MOVE-CORRESPONDING ls_dfies TO ls_fcat.
ls_fcat-fieldname = ls_defin-fieldname.
MOVE: ls_dfies-keyflag TO ls_fcat-key,
ls_dfies-scrtext_m TO ls_fcat-seltext_l,
ls_dfies-domname TO l_dname.
ENDIF.
ELSE.
* Try to get info about structure
ls_defin-ref_tabname = ls_defin-ref_fieldname.
CALL FUNCTION 'DDIF_FIELDINFO_GET'
EXPORTING
tabname = ls_defin-ref_tabname
TABLES
dfies_tab = lt_dfies
EXCEPTIONS
OTHERS = 0.
IF NOT lt_dfies IS INITIAL.
* Process fields of this structure
LOOP AT lt_dfies INTO ls_dfies.
CLEAR: ls_fcat.
MOVE-CORRESPONDING ls_dfies TO ls_fcat.
CONCATENATE ls_defin-fieldname ls_fcat-fieldname
INTO ls_fcat-fieldname
SEPARATED BY '-'.
MOVE ls_dfies-keyflag TO ls_fcat-key.
MOVE ls_dfies-scrtext_m TO ls_fcat-seltext_l.
ls_fcat-tabname = me->g_table.
CLEAR: ls_fcat-col_pos,
ls_fcat-offset.
IF ls_fcat-ref_tabname IS INITIAL.
ls_fcat-ddictxt = 'L'.
ENDIF.
* Display Yes/No fields as checkboxes
IF ls_dfies-domname = 'XFELD'.
ls_fcat-checkbox = 'X'.
ENDIF.

* Add field to field catalog
APPEND ls_fcat TO fcat.
ENDLOOP.
ELSE.
* Try to get info about data element
CALL FUNCTION 'DDIF_DTEL_GET'
EXPORTING
name = ls_fcat-ref_fieldname
langu = sy-langu
IMPORTING
dd04v_wa = ls_dd04v
EXCEPTIONS
illegal_input = 1
OTHERS = 2.
IF sy-subrc = 0.
MOVE-CORRESPONDING ls_dd04v TO ls_fcat.
MOVE: ls_dd04v-scrtext_m TO ls_fcat-seltext_l,
ls_dd04v-domname TO l_dname.
ELSE.
* Finally try to get info about domain
CALL FUNCTION 'DDIF_DOMA_GET'
EXPORTING
name = ls_fcat-ref_fieldname
langu = sy-langu
IMPORTING
dd01v_wa = ls_dd01v
EXCEPTIONS
illegal_input = 1
OTHERS = 2.
IF sy-subrc = 0.
MOVE-CORRESPONDING ls_dd01v TO ls_fcat.
MOVE: ls_dd01v-ddtext TO ls_fcat-seltext_l,
ls_dd01v-domname TO l_dname.
ENDIF.
ENDIF.
ENDIF.
ENDIF.
* Table name must be internal table containing data
ls_fcat-tabname = g_table.
* No offset
CLEAR: ls_fcat-offset.
* Default text is stored in long text
IF ls_fcat-ref_tabname IS INITIAL.
ls_fcat-ddictxt = 'L'.
ENDIF.
* Display Yes/No fields as checkboxes
IF l_dname = 'XFELD'.
ls_fcat-checkbox = 'X'.
ENDIF.

* Add field to field catalog
APPEND ls_fcat TO fcat.
ENDLOOP.
* Link between fields
DESCRIBE TABLE fcat LINES l_nbfld.
LOOP AT fcat INTO ls_fcat.
IF sy-tabix NE l_nbfld.
l_index = sy-tabix + 1.
READ TABLE fcat INTO ls_fcat2 INDEX l_index.
IF sy-subrc = 0.
IF ls_fcat-datatype = 'CURR'.
* Currency unit
IF ls_fcat2-datatype = 'CUKY'.
ls_fcat-cfieldname = ls_fcat2-fieldname.
ls_fcat-ctabname = ls_fcat2-tabname.
MODIFY fcat FROM ls_fcat.
ELSE.
LOOP AT fcat INTO ls_fcat2
FROM l_index
WHERE datatype = 'CUKY'.
* First currency unit after field
ls_fcat-cfieldname = ls_fcat2-fieldname.
ls_fcat-ctabname = ls_fcat2-tabname.
MODIFY fcat FROM ls_fcat.
EXIT.
ENDLOOP.
IF sy-subrc NE 0.
* No currency unit after field, try before
READ TABLE fcat INTO ls_fcat2
WITH KEY datatype = 'CUKY'.
IF sy-subrc = 0.
ls_fcat-cfieldname = ls_fcat2-fieldname.
ls_fcat-ctabname = ls_fcat2-tabname.
MODIFY fcat FROM ls_fcat.
ENDIF.
ENDIF.
ENDIF.
ENDIF.
IF ls_fcat-datatype = 'QUAN'.
* Quantity unit
IF ls_fcat2-datatype = 'UNIT'.
ls_fcat-cfieldname = ls_fcat2-fieldname.
ls_fcat-ctabname = ls_fcat2-tabname.
MODIFY fcat FROM ls_fcat.
ENDIF.
ENDIF.
ENDIF.
ENDIF.
ENDLOOP.
ENDMETHOD.
***
* Get definition of type from code source
***
METHOD get_definition.
DATA: l_strng TYPE rssource,
ls_abap TYPE rssource,
l_fdpos TYPE i,
l_first TYPE i,
l_lastr TYPE i.

DATA: lt_incl TYPE TABLE OF repid,
ls_incl TYPE repid.

* Get program code
READ REPORT repid INTO abap.
CHECK sy-subrc EQ 0.

* Get first line of definition
CONCATENATE 'BEGIN OF' struc INTO l_strng
SEPARATED BY space.
LOOP AT abap INTO ls_abap.
IF ls_abap CS l_strng.
l_fdpos = strlen( l_strng ) + sy-fdpos.
IF ls_abap+l_fdpos(1) CA ', "'.
l_first = sy-tabix.
EXIT.
ENDIF.
ENDIF.
ENDLOOP.
IF l_first IS INITIAL.
* Table is defined in an include
CALL FUNCTION 'RS_GET_ALL_INCLUDES'
EXPORTING
program = repid
TABLES
includetab = lt_incl
EXCEPTIONS
OTHERS = 1.
IF sy-subrc = 0.
LOOP AT lt_incl INTO ls_incl.
* Try to find definition in this include
READ REPORT ls_incl INTO abap.
LOOP AT abap INTO ls_abap.
IF ls_abap CS l_strng.
l_fdpos = strlen( l_strng ) + sy-fdpos.
IF ls_abap+l_fdpos(1) CA ',. "'.
l_first = sy-tabix.
EXIT.
ENDIF.
ENDIF.
ENDLOOP.
IF NOT l_first IS INITIAL.
EXIT.
ENDIF.
ENDLOOP.
ENDIF.
ENDIF.

* Get last line of definition
CONCATENATE 'END OF' struc INTO l_strng
SEPARATED BY space.
LOOP AT abap INTO ls_abap.
IF ls_abap CS l_strng.
l_fdpos = strlen( l_strng ) + sy-fdpos.
IF ls_abap+l_fdpos(1) CA ',. "'.
l_lastr = sy-tabix - l_first.
EXIT.
ENDIF.
ENDIF.
ENDLOOP.

* Keep only relevant code lines
IF l_first LE 0
OR l_lastr LE 0.
REFRESH abap.
ELSE.
DELETE abap TO l_first.
DELETE abap FROM l_lastr.
ENDIF.
ENDMETHOD.
***
* Get definition of type recursively
***
METHOD recursive_definition.
DATA: lt_token TYPE TABLE OF stokex,
ls_token TYPE stokex,
lt_state TYPE TABLE OF sstmnt,
ls_state TYPE sstmnt.

DATA: ls_defin TYPE ty_defin,
l_reffld TYPE fieldname.

DATA: lt_recu TYPE TABLE OF rssource.

* Retrieve tokens
SCAN ABAP-SOURCE abap
TOKENS INTO lt_token
STATEMENTS INTO lt_state.

LOOP AT lt_state INTO ls_state.
CLEAR: ls_defin.
* Field name
READ TABLE lt_token INTO ls_token
INDEX ls_state-from.
ls_defin-fieldname = ls_token-str.
* Reference type
READ TABLE lt_token INTO ls_token
INDEX ls_state-to.
l_reffld = ls_token-str.
* Check if this type is defined in program
FREE: lt_recu.
CALL METHOD get_definition EXPORTING repid = repid
struc = l_reffld
CHANGING abap = lt_recu.
IF lt_recu IS INITIAL.
IF NOT g_level IS INITIAL.
CONCATENATE g_level ls_defin-fieldname INTO ls_defin-fieldname
SEPARATED BY '-'.
CONDENSE ls_defin-fieldname.
ENDIF.
IF l_reffld CS '-'.
SPLIT l_reffld AT '-'
INTO ls_defin-ref_tabname
ls_defin-ref_fieldname.
IF ls_defin-ref_tabname = 'SY'.
ls_defin-ref_tabname = 'SYST'.
ENDIF.
ELSE.
ls_defin-ref_fieldname = ls_token-str.
ENDIF.
APPEND ls_defin TO me->gt_defin.
ELSE.
* Process sub levels
IF me->g_level IS INITIAL.
me->g_level = ls_defin-fieldname.
ELSE.
CONCATENATE me->g_level ls_defin-fieldname INTO me->g_level
SEPARATED BY '-'.
ENDIF.
CALL METHOD recursive_definition EXPORTING repid = repid
CHANGING abap = lt_recu.
IF me->g_level CS '-'.
SHIFT me->g_level RIGHT UP TO '-'.
SHIFT me->g_level RIGHT.
SHIFT me->g_level LEFT DELETING LEADING space.
ELSE.
CLEAR: me->g_level.
ENDIF.
ENDIF.
ENDLOOP.
ENDMETHOD.
***
* Set table name
***
METHOD set_table_name.
me->g_table = in_tabname.
ENDMETHOD.
***
* Set title
***
METHOD set_alv_title.
me->g_title = in_title.
ENDMETHOD.
***
* Set settings
***
METHOD set_alv_settings.
CALL METHOD map_structure EXPORTING source = in_settings
CHANGING destin = me->gs_sett.
ENDMETHOD.
***
* Set layout
***
METHOD set_alv_layout.
CALL METHOD map_structure EXPORTING source = in_layout
CHANGING destin = me->gs_layo.
ENDMETHOD.
***
* Add event
***
METHOD set_alv_event.
DATA: ls_evnt TYPE slis_alv_event.

ls_evnt-name = in_name.
ls_evnt-form = in_form.
COLLECT ls_evnt INTO gt_evnt.
ENDMETHOD.
***
* Map fields from incoming structure into attribute
***
METHOD map_structure.
DATA: ob_desc TYPE REF TO cl_abap_structdescr,
ls_compo TYPE abap_compdescr.

FIELD-SYMBOLS: <field> TYPE ANY,
<struc> TYPE ANY.

ob_desc ?= cl_abap_typedescr=>describe_by_data( destin ).

LOOP AT ob_desc->components INTO ls_compo.
ASSIGN COMPONENT ls_compo-name OF STRUCTURE source TO <field>.
IF <field> IS ASSIGNED.
ASSIGN COMPONENT ls_compo-name OF STRUCTURE destin TO <struc>.
CATCH SYSTEM-EXCEPTIONS conversion_errors = 1.
MOVE <field> TO <struc>.
ENDCATCH.
UNASSIGN <field>.
ENDIF.
ENDLOOP.
ENDMETHOD.
ENDCLASS.
Responder Con Cita