Posted: Mon Nov 05, 2007 2:15 pm Post subject: Demo: Bar Chart Control
Code:
REPORT barcocx1 MESSAGE-ID cg.
INCLUDE sgrccnst. "Allgemeine Konstanten der Grafik
INCLUDE lbarccon. "Konstanten zum Balkenplan
INCLUDE barcdata. "Allgemeine Datendeklarationen
* Objekttabellen zum Halten der Grafikdaten im ABAP (Verprobungen)
DATA: all_boxes LIKE bcboxes OCCURS 0 WITH HEADER LINE, "Boxen
all_box_vals LIKE bcvals OCCURS 0 WITH HEADER LINE, "Attrib.
all_links LIKE bclinks OCCURS 0 WITH HEADER LINE, "Kanten
all_link_vals LIKE bcnvals OCCURS 0 WITH HEADER LINE, "Kanten
all_nodes LIKE bcnodes OCCURS 0 WITH HEADER LINE, "Knoten
all_node_vals LIKE bcnvals OCCURS 0 WITH HEADER LINE, "Attrib.
all_positions LIKE bcposition OCCURS 0 WITH HEADER LINE. "Posit.
* Temporфre Tabellen
DATA: tmp_boxes LIKE bcboxes OCCURS 0 WITH HEADER LINE, "Boxen
tmp_nodes LIKE bcnodes OCCURS 0 WITH HEADER LINE. "Knoten
* Verwendete Layertypen
DATA: BEGIN OF layer_types OCCURS 0,
type LIKE tbcl-type,
END OF layer_types.
* Blфttern in Selektionsdynpro
DATA: BEGIN OF scroll_tab OCCURS 0,
flag(1) TYPE c,
END OF scroll_tab.
* Attribute im Modifikationdynpro
DATA: vals LIKE bcvals OCCURS 0 WITH HEADER LINE.
* Excluding-Tabelle f№r CUA-Status
DATA: BEGIN OF excluding_tab OCCURS 0.
INCLUDE STRUCTURE sgrcexclud.
DATA: END OF excluding_tab.
* Einstellungen im Optionenprofil
DATA: settings LIKE barc_set.
* Datumslinie f№r Einf№gedynpro
DATA: BEGIN OF dateline,
chart_id LIKE bcdatlin-chart_id,
color_type LIKE bcdatlin-color_type,
date LIKE bcdatlin-date,
END OF dateline.
* Diverse Variablen
DATA: act_box_id LIKE bcboxes-id,
act_node_id LIKE bcnodes-id,
act_link_id LIKE bclinks-id,
anz TYPE i,
anz_b TYPE i, "Boxen
anz_n TYPE i, "Knoten
calendar1 LIKE bccalendar-id,
chart1 LIKE bcchart-id,
chart2 LIKE bcchart-id,
con_d LIKE object_type VALUE 'D', "Datumslinie
con_g LIKE object_type VALUE 'V', "Grid
con_r LIKE object_type VALUE 'R', "Ribbon
con_s LIKE object_type VALUE 'S', "Section
count TYPE i,
entry_act LIKE sy-tabix,
entry_to LIKE sy-tabix,
entry_new LIKE sy-tabix,
errno(2) TYPE c,
firstdate LIKE tbcl-firstdate,
fl LIKE bcvals-fl,
graph_cmd_info LIKE bccmdinfo,
gr_sel_field LIKE net_graph-sel_field,
layer_type LIKE tbcl-type,
layer_kind LIKE tbcl-layer_type,
line_count LIKE sy-tabix,
line_count_b LIKE sy-tabix VALUE 4, "Boxen
line_count_n LIKE sy-tabix VALUE 8, "Knoten
line_count_sel LIKE sy-tabix VALUE 10, "Selekt.
line_count_val LIKE sy-tabix VALUE 4, "Attrib.
max_pos LIKE bcposition-row_number,
ok_code TYPE syucomm,
save_ok_code LIKE ok_code,
seconddate LIKE tbcl-seconddate,
section1 LIKE bcsection-id,
section2 LIKE bcsection-id,
section3 LIKE bcsection-id,
symboltype LIKE tbcl-symboltype,
tabix TYPE i.
*----------------------------f№r Umstellung auf OCX -------------------*
INCLUDE <ctldef>.
DATA: barc_ocx TYPE cntl_handle,
ws(4) TYPE c,
this_repid LIKE sy-repid,
this_dynnr LIKE sy-dynnr.
* USAGE allowed in SAP internal test reports, only
INCLUDE applg_auto_test_init.
* Selection-screen
PARAMETER: ocx AS CHECKBOX DEFAULT 'X'. "f№r OCX-Umstellung
*----------------------------f№r Umstellung auf OCX -------------------*
SELECTION-SCREEN ULINE.
SELECTION-SCREEN BEGIN OF BLOCK b1 WITH FRAME TITLE text-001.
PARAMETER: gruppe LIKE tbcgt-prf_gruppe DEFAULT 'DEMO',
name LIKE tbcgt-prf_name DEFAULT '000000000001',
index LIKE tbcgt-prf_index DEFAULT '3'.
SELECTION-SCREEN END OF BLOCK b1.
* Auswertung des Benutzerkommandos
CASE graph_cmd.
*----------------------------------------------------------------------*
WHEN bc_const-ask_for_insert. "einf№gen
abap_cmd = graph_cmd.
*----------------------------------------------------------------------*
WHEN bc_const-double_click. "doppelklicken
abap_cmd = bc_const-ask_for_modify.
graph_cmd = bc_const-ask_for_modify.
DESCRIBE TABLE boxes LINES anz. "Box
IF NOT anz IS INITIAL.
object_type = bc_const-box_object.
READ TABLE boxes INDEX 1.
LOOP AT all_boxes WHERE id = boxes-id.
EXIT.
ENDLOOP. "at ALL_BOXES
MOVE-CORRESPONDING all_boxes TO boxes.
MODIFY boxes INDEX 1.
LOOP AT all_box_vals WHERE id = boxes-id.
MOVE-CORRESPONDING all_box_vals TO box_vals.
APPEND box_vals.
ENDLOOP. "at ALL_BOX_VALS
SORT box_vals BY fl.
entry_act = 1.
CALL SCREEN 100 STARTING AT 2 2 ENDING AT 53 13.
CLEAR boxes.
REFRESH boxes.
ENDIF. "if not ANZ is initial.
DESCRIBE TABLE nodes LINES anz. "Node
IF NOT anz IS INITIAL.
object_type = bc_const-node_object.
READ TABLE nodes INDEX 1.
LOOP AT all_nodes WHERE id = nodes-id.
EXIT.
ENDLOOP. "at ALL_NODES
MOVE-CORRESPONDING all_nodes TO nodes.
MODIFY nodes INDEX 1.
LOOP AT all_node_vals WHERE id = nodes-id.
MOVE-CORRESPONDING all_node_vals TO node_vals.
APPEND node_vals.
ENDLOOP. "at ALL_NODE_VALS
SORT node_vals BY fl.
entry_act = 1.
CALL SCREEN 101 STARTING AT 2 2 ENDING AT 53 16.
CLEAR nodes.
REFRESH nodes.
ENDIF. "if not ANZ is initial.
*----------------------------------------------------------------------*
WHEN bc_const-ask_for_delete. "lЎschen
abap_cmd = graph_cmd.
*----------------------------------------------------------------------*
WHEN bc_const-ask_for_movelayer. "Layer verschieben
abap_cmd = graph_cmd.
*----------------------------------------------------------------------*
WHEN bc_const-ask_for_movenode. "Knoten verschieben
abap_cmd = graph_cmd.
*----------------------------------------------------------------------*
WHEN bc_const-ask_for_movemulti. "mehrere Knoten verschieben
abap_cmd = graph_cmd.
*----------------------------------------------------------------------*
WHEN bc_const-ask_for_movebox. "Box verschieben
abap_cmd = graph_cmd.
READ TABLE positions INDEX 1.
CHECK sy-subrc IS INITIAL.
READ TABLE all_boxes WITH KEY positions-obj_id.
CHECK sy-subrc IS INITIAL.
IF positions-chart_id <all_boxes> max_pos.
max_pos = all_positions-row_number.
ENDIF.
ENDLOOP. "at ALL_POSITIONS
LOOP AT positions WHERE chart_id = chart_id.
IF positions-row_number > max_pos.
max_pos = positions-row_number.
ENDIF.
ENDLOOP. "at POSITIONS
ENDFORM. " GET_MAX_POS
*---------------------------------------------------------------------*
* FORM MAKE_NEXT_LAYER_TYPE *
*---------------------------------------------------------------------*
* Nфchsten Layertyp erzeugen *
*---------------------------------------------------------------------*
FORM make_next_layer_type TABLES layer_types STRUCTURE layer_types
USING profile LIKE graph_profile
l_type LIKE tbcl-type.
DATA: i TYPE i,
n(2) TYPE n.
CLEAR l_type.
DESCRIBE TABLE layer_types LINES anz.
IF anz = 0.
* Layertypen aus DB holen
PERFORM get_layer_types TABLES layer_types
USING profile.
ENDIF. "if ANZ = 0
DO.
i = i + 1.
IF i > 99.
EXIT.
ENDIF.
n = i.
READ TABLE layer_types WITH KEY n.
IF NOT sy-subrc IS INITIAL.
l_type = n.
EXIT.
ENDIF.
ENDDO.
IF NOT l_type IS INITIAL.
layer_types-type = l_type.
APPEND layer_types.
ENDIF.
ENDFORM. "MAKE_NEXT_LAYER_TYPE
*---------------------------------------------------------------------*
* FORM SET_CUA_STATUS. *
*---------------------------------------------------------------------*
* Pflegen der CUA-Oberflфche №ber den CUA-Painter *
*---------------------------------------------------------------------*
FORM set_cua_status.
DATA: prog LIKE sy-repid.
prog = sy-repid.
* CUA-Status
CALL FUNCTION 'GRAPH_SET_CUA_STATUS'
EXPORTING
program = prog
status = 'GRAFIK'
TABLES
excluding = excluding_tab
EXCEPTIONS
inv_cua_info = 01.
REFRESH excluding_tab.
* Fenstertitel
SET TITLEBAR '011'.
ENDFORM. "form SET_CUA_STATUS
*---------------------------------------------------------------------*
* FORM SET_BOXES *
*---------------------------------------------------------------------*
* Festlegen der Boxen (Tabellenteil) *
*---------------------------------------------------------------------*
FORM set_boxes TABLES boxes STRUCTURE bcboxes
box_vals STRUCTURE bcvals
positions STRUCTURE bcposition
USING act_box_id LIKE bcboxes-id
chart1 LIKE bcchart-id
chart2 LIKE bcchart-id.
*-Boxen in Chart1 -----------------------------------------------------*
act_box_id = act_box_id + 1.
*----------------------------------------------------------------------*
* Form SET_CALENDAR
*----------------------------------------------------------------------*
* Kalender definieren *
*----------------------------------------------------------------------*
FORM set_calendar USING calendar LIKE bccalendar-id.
DATA: to1 LIKE bctimeobj-id,
to2 LIKE bctimeobj-id,
int1 LIKE bcinterval-id,
prof1 LIKE bctimeprof-id,
val LIKE bcvals-val.
* Kalender definieren
CALL FUNCTION 'BARC_ADD_CALENDAR'
IMPORTING
id = calendar.
* Frei am Wochenende -------------------------------------------------*
CALL FUNCTION 'BARC_ADD_TIME_OBJECT'
EXPORTING
fl = bc_const-day_in_week
r_val = bc_const-saturday
timeobject_type = bc_const-recurrent
IMPORTING
id = to1.
CALL FUNCTION 'BARC_ADD_TIME_OBJECT'
EXPORTING
fl = bc_const-day_in_week
r_val = bc_const-sunday
timeobject_type = bc_const-recurrent
IMPORTING
id = to2.
CALL FUNCTION 'BARC_ADD_TIME_PROFILE'
EXPORTING
timeprof_type = bc_const-week
IMPORTING
id = prof1.
WRITE to1 TO val.
CALL FUNCTION 'BARC_SET_TIME_PROFILE_ATTRIB'
EXPORTING
fl = bc_const-add_nw_time
id = prof1
val = val.
WRITE to2 TO val.
CALL FUNCTION 'BARC_SET_TIME_PROFILE_ATTRIB'
EXPORTING
fl = bc_const-add_nw_time
id = prof1
val = val.
WRITE prof1 TO val.
CALL FUNCTION 'BARC_SET_CALENDAR_ATTRIB'
EXPORTING
fl = bc_const-add_profile
id = calendar
val = val.
* Ferien abziehen -----------------------------------------------------*
CALL FUNCTION 'BARC_ADD_TIME_OBJECT'
EXPORTING
u_val = '20.03.1999'
IMPORTING
id = to1.
CALL FUNCTION 'BARC_ADD_TIME_OBJECT'
EXPORTING
u_val = '10.04.1999'
IMPORTING
id = to2.
CALL FUNCTION 'BARC_ADD_INTERVAL'
IMPORTING
id = int1.
WRITE to1 TO val.
CALL FUNCTION 'BARC_SET_INTERVAL_ATTRIB'
EXPORTING
fl = bc_const-interval_start
id = int1
val = val.
WRITE to2 TO val.
CALL FUNCTION 'BARC_SET_INTERVAL_ATTRIB'
EXPORTING
fl = bc_const-interval_end
id = int1
val = val.
WRITE int1 TO val.
CALL FUNCTION 'BARC_SET_CALENDAR_ATTRIB'
EXPORTING
fl = bc_const-unique_interval
id = calendar
val = val.
ENDFORM. " SET_CALENDAR
*---------------------------------------------------------------------*
* FORM SET_CHARTS *
*---------------------------------------------------------------------*
* Festlegen der Charts *
*---------------------------------------------------------------------*
FORM set_charts TABLES boxes STRUCTURE bcboxes
box_vals STRUCTURE bcvals
positions STRUCTURE bcposition
USING act_box_id LIKE bcboxes-id
chart1 LIKE bcchart-id
chart2 LIKE bcchart-id
section1 LIKE bcsection-id
section2 LIKE bcsection-id
section3 LIKE bcsection-id
calendar1 LIKE bccalendar-id.
DATA: val LIKE bcvals-val.
* Chart 1 festlegen
CALL FUNCTION 'BARC_ADD_CHART'
EXPORTING
column_anz = 3
index = 1
size = 300
chart_type = '00'
IMPORTING
id = chart1
EXCEPTIONS
inv_winid = 01.
CALL FUNCTION 'BARC_SET_CHART_ATTRIB'
EXPORTING
id = chart1
fl = bc_const-chart_title_box
val = val.
* R№ckmeldung auf einzelnen Zeilen beim mehrfachen Verschieben
CALL FUNCTION 'BARC_SET_CHART_ATTRIB'
EXPORTING
id = chart1
fl = bc_const-multi_line_confirm
val = bc_const-x.
* Breite der Spalten im Tabellenteil
CALL FUNCTION 'BARC_SET_COLUMN_WIDTH'
EXPORTING
chart_id = chart1
index = 1
width = 1500.
CALL FUNCTION 'BARC_SET_COLUMN_WIDTH'
EXPORTING
chart_id = chart1
index = 2
width = 3500.
CALL FUNCTION 'BARC_SET_COLUMN_WIDTH'
EXPORTING
chart_id = chart1
index = 3
width = 2000.
CALL FUNCTION 'BARC_SET_CHART_ATTRIB'
EXPORTING
id = chart2
fl = bc_const-chart_title_box
val = val.
* R№ckmeldung auf einzelnen Zeilen beim mehrfachen Verschieben
CALL FUNCTION 'BARC_SET_CHART_ATTRIB'
EXPORTING
id = chart2
fl = bc_const-multi_line_confirm
val = bc_const-x.
* Breite der Spalten im Tabellenteil
CALL FUNCTION 'BARC_SET_COLUMN_WIDTH'
EXPORTING
chart_id = chart2
index = 1
width = 3000.
CALL FUNCTION 'BARC_SET_COLUMN_WIDTH'
EXPORTING
chart_id = chart2
index = 2
width = 4000.
*---------------------------------------------------------------------*
* FORM SET_NODES *
*---------------------------------------------------------------------*
* Festlegen der Knoten (Diagrammteil) *
*---------------------------------------------------------------------*
FORM set_nodes TABLES nodes STRUCTURE bcnodes
node_vals STRUCTURE bcnvals
positions STRUCTURE bcposition
USING act_node_id LIKE bcnodes-id
chart1 LIKE bcchart-id
chart2 LIKE bcchart-id
calendar1 LIKE bccalendar-id.
*---------------------------------------------------------------------*
* FORM SET_TIME_AXIS *
*---------------------------------------------------------------------*
* Festlegen der Zeitachse *
*---------------------------------------------------------------------*
FORM set_time_axis USING section1 LIKE bcsection-id
section2 LIKE bcsection-id
section3 LIKE bcsection-id.
* Start und Ende der Zeitachse festlegen
CALL FUNCTION 'BARC_SET_TIME_AXIS'
EXPORTING
start = '01.01.1999;'
end = '31.12.2000;'.
* Sektionen festlegen
CALL FUNCTION 'BARC_ADD_SECTION'
EXPORTING
size = 50
start = '01.01.1999;'
unit = '5'
IMPORTING
id = section1.
CALL FUNCTION 'BARC_ADD_SECTION'
EXPORTING
size = 100
start = '15.03.1999;'
unit = '5'
IMPORTING
id = section2.
CALL FUNCTION 'BARC_ADD_SECTION'
EXPORTING
size = 50
start = '01.03.2000;'
unit = '5'
IMPORTING
id = section3.
*---------------------------------------------------------------------*
* MODULE OK_CODE_BARC INPUT *
*---------------------------------------------------------------------*
* OK_Code-Verarbeitung in den Modifikationsdynpros *
*---------------------------------------------------------------------*
MODULE ok_code_barc INPUT.
save_ok_code = ok_code.
CLEAR ok_code.
CASE save_ok_code.
WHEN 'UPDA'.
CASE object_type.
WHEN bc_const-box_object. "Box
box_vals-id = boxes-id.
box_vals-fl = bc_const-form_type. "Formtyp
box_vals-val = boxes-form_type.
APPEND box_vals.
box_vals-fl = bc_const-color_type. "Farbtyp
box_vals-val = boxes-color_type.
APPEND box_vals.
ENDCASE. "case OBJECT_TYPE
SET SCREEN 0.
LEAVE SCREEN.
WHEN 'ABBR'.
CASE object_type.
WHEN bc_const-box_object. "Box
REFRESH box_vals.
WHEN bc_const-node_object. "Node
REFRESH node_vals.
WHEN con_d. "Dateline
CLEAR dateline.
WHEN con_g. "Grid
REFRESH vals.
WHEN con_r. "Ribbon
REFRESH vals.
WHEN con_s. "Section
REFRESH vals.
ENDCASE. "case OBJECT_TYPE
SET SCREEN 0.
LEAVE SCREEN.
WHEN OTHERS.
CASE object_type.
WHEN bc_const-box_object. "Box
DESCRIBE TABLE box_vals LINES entry_to.
line_count = line_count_b.
WHEN bc_const-node_object. "Node
DESCRIBE TABLE node_vals LINES entry_to.
line_count = line_count_n.
WHEN con_g. "Grid
DESCRIBE TABLE vals LINES entry_to.
line_count = line_count_val.
WHEN con_r. "Ribbon
DESCRIBE TABLE vals LINES entry_to.
line_count = line_count_val.
WHEN con_s. "Section
DESCRIBE TABLE vals LINES entry_to.
line_count = line_count_val.
ENDCASE. "case OBJECT_TYPE
*Text elements
*----------------------------------------------------------
* 024 Offer
* 023 Plnt
* 022 Name
* 021 No.
* 020 Title table part
* 019 Title
* 025 No Object Selected
* 026 Not possible to move boxes between charts
* 006 Node inserted
* 005 Box inserted
* 004 Box already exists in the line
* 003 Box/node duplicated
* 002 End of loading process
* 001 Graphics Profile
* 007 Cannot change plant
* 016 Box
* 015 Resources
* 014 No free text index available
* 008 Fld content changed
* 012 Layer inserted
* 013 No free layer type available
*Selection texts
*----------------------------------------------------------
* OCX Call as control
* NAME Name
* INDEX Index
* GRUPPE Group
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum You cannot attach files in this forum You can download files in this forum
All product names are trademarks of their respective companies. SAPNET.RU websites are in no way affiliated with SAP AG. SAP, SAP R/3, R/3 software, mySAP, ABAP, BAPI, xApps, SAP NetWeaver and any other are registered trademarks of SAP AG. Every effort is made to ensure content integrity. Use information on this site at your own risk.