Posted: Mon Nov 05, 2007 3:08 pm Post subject: Demo: Network Control with Callback Processing
Code:
PROGRAM netzocx2 MESSAGE-ID cg.
INCLUDE lcnetdat. "allg. Datendeklarationen
INCLUDE lcnetcon. "Konstanten
INCLUDE sgrccnst. "allg. Konstanten Grafik
* Objekttabellen zum Halten der Grafikdaten im ABAP (Verprobung)
DATA: all_clusters_tab LIKE cng_clustr OCCURS 0 WITH HEADER LINE,
all_cvals_tab LIKE net_cvals OCCURS 0 WITH HEADER LINE,
all_nodes_tab LIKE cng_inodes OCCURS 0 WITH HEADER LINE,
all_nvals_tab LIKE net_nvals OCCURS 0 WITH HEADER LINE,
all_lines_tab LIKE cng_lines OCCURS 0 WITH HEADER LINE,
all_lvals_tab LIKE net_lvals OCCURS 0 WITH HEADER LINE.
DATA: BEGIN OF field_tab OCCURS 0, "Modifizieren graf. Objekt
id LIKE cng_inodes-id,
fl LIKE net_nvals-fl,
val LIKE net_nvals-val,
color LIKE thlt-bg_col,
END OF field_tab.
DATA: BEGIN OF node_line, "Modifizieren graf. Objekt
id LIKE cng_inodes-id,
type LIKE cng_inodes-type,
END OF node_line.
DATA: BEGIN OF scroll_tab OCCURS 0, "BlЇttern in Sel. u. Pos.
flag(1) TYPE c,
END OF scroll_tab.
DATA: anz TYPE i,
anz_c TYPE i,
anz_l TYPE i,
anz_n TYPE i,
def_headertext LIKE net_nvals-val,
entry_act TYPE i,
entry_to TYPE i,
entry_new TYPE i,
g_repid LIKE sy-repid,
headertext LIKE net_nvals-val,
line_count TYPE i VALUE 4,
line_count_1 TYPE i VALUE 10,
ok-code(4) TYPE c,
save_ok-code LIKE ok-code,
time_egg_text LIKE net_nvals-val.
* USAGE allowed in SAP internal test reports, only
INCLUDE applg_auto_test_init.
SELECTION-SCREEN BEGIN OF BLOCK b1 WITH FRAME TITLE text-010.
PARAMETER: prf_grup LIKE tcngt-prf_gruppe DEFAULT 'DEMO',
prf_name LIKE tcngt-prf_name DEFAULT '000000000001',
prf_indx LIKE tcngt-prf_index DEFAULT '1'.
SELECTION-SCREEN END OF BLOCK b1.
g_repid = sy-repid.
*----------------------------f_r Umstellung auf OCX -------------------*
INCLUDE <ctldef>.
IF NOT sy-subrc IS INITIAL. "Falls sich Control nicht erzeugen lЇяt
* Setzen CUA-Status und Fenstertitel, wie bisher
PERFORM set_cua_status.
ENDIF.
*----------------------------f_r Umstellung auf OCX -------------------*
* Daten f_r Grafik zusammenstellen
PERFORM collect_data.
* Callback-Routine f_r PAI
CALL FUNCTION 'SGRC_ADD_CALLBACK'
EXPORTING
call_back_form = 'ACTION_CALLBACK'
call_back_prog = g_repid
pai = 'X'
pai_interest = 'I' "Benutzerkommando
winid = net_const-def_id
control_handle = netz_ocx.
* Callback-Routine f_r Schlieяen der Grafik
CALL FUNCTION 'SGRC_ADD_CALLBACK'
EXPORTING
call_back_form = 'EXIT_CALLBACK'
call_back_prog = g_repid
pai = 'X'
pai_interest = 'D' "Grafik geschloяen
winid = net_const-def_id
control_handle = netz_ocx.
* Schleifenverarbeitung starten
CALL FUNCTION 'SGRC_MAIN_LOOP'
EXPORTING
control_handle = netz_ocx.
* USAGE allowed in SAP internal test reports, only
INCLUDE applg_auto_test_form.
*---------------------------------------------------------------------*
* FORM PBO_CALLBACK *
*---------------------------------------------------------------------*
* PBO-Verarbeitung *
*---------------------------------------------------------------------*
FORM pbo_callback.
SET TITLEBAR '006'.
SET PF-STATUS 'GRAFIK'.
* USAGE allowed in SAP internal test reports, only
PERFORM auto_test_pbo USING 'EXIT'.
ENDFORM. "PBO_CALLBACK
*---------------------------------------------------------------------*
* FORM ACTION_CALLBACK *
*---------------------------------------------------------------------*
* Verarbeitung der Aktionen in der Grafik *
*---------------------------------------------------------------------*
FORM action_callback.
*---------------------------------------------------------------------*
* FORM FIELD_TO_TEXTINDEX_CVALS *
*---------------------------------------------------------------------*
* Feldname in Textindex umwandeln *
*---------------------------------------------------------------------*
FORM field_to_textindex_cvals TABLES cvals STRUCTURE net_cvals
all_clusters STRUCTURE cng_clustr.
LOOP AT all_clusters WHERE id = cvals-id.
EXIT.
ENDLOOP.
IF sy-subrc IS INITIAL.
CALL FUNCTION 'CNET_FIELD_TO_INDEX_CVALS'
EXPORTING
cluster_type = all_clusters-type
TABLES
cvals = cvals.
ENDIF. "if SY-SUBRC is initial
ENDFORM. "form FIELD_TO_TEXTINDEX_CVALS
*---------------------------------------------------------------------*
* FORM FIELD_TO_TEXTINDEX_LVALS *
*---------------------------------------------------------------------*
* Feldname in Textindex umwandeln *
*---------------------------------------------------------------------*
FORM field_to_textindex_lvals TABLES lvals STRUCTURE net_lvals
all_lines STRUCTURE cng_lines.
LOOP AT all_lines WHERE id = lvals-id.
EXIT.
ENDLOOP.
IF sy-subrc IS INITIAL.
CALL FUNCTION 'CNET_FIELD_TO_INDEX_LVALS'
EXPORTING
line_type = all_lines-type
TABLES
lvals = lvals.
ENDIF. "if SY-SUBRC is initial
ENDFORM. "form FIELD_TO_TEXTINDEX_LVALS
*---------------------------------------------------------------------*
* FORM FIELD_TO_TEXTINDEX_NVALS *
*---------------------------------------------------------------------*
* Feldname in Textindex umwandeln *
*---------------------------------------------------------------------*
FORM field_to_textindex_nvals TABLES nvals STRUCTURE net_nvals
all_nodes STRUCTURE cng_inodes.
LOOP AT all_nodes WHERE id = nvals-id.
EXIT.
ENDLOOP.
IF sy-subrc IS INITIAL.
CALL FUNCTION 'CNET_FIELD_TO_INDEX_NVALS'
EXPORTING
node_type = all_nodes-type
TABLES
nvals = nvals.
ENDIF. "if SY-SUBRC is initial
ENDFORM. "form FIELD_TO_TEXTINDEX_NVALS
*---------------------------------------------------------------------*
* FORM MAKE_CLUSTERS *
*---------------------------------------------------------------------*
* Erzeugen der Cluster *
*---------------------------------------------------------------------*
FORM make_clusters TABLES clusters STRUCTURE cng_clustr
cvals STRUCTURE net_cvals.
*---------------------------------------------------------------------*
* FORM SET_CUA_STATUS. *
*---------------------------------------------------------------------*
* Pflegen der CUA-OberflЇche _ber den CUA-Painter *
*---------------------------------------------------------------------*
FORM set_cua_status.
DATA: BEGIN OF excluding_tab OCCURS 0.
INCLUDE STRUCTURE sgrcexclud.
DATA: END OF excluding_tab.
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 = 1.
READ TABLE cvals INDEX 1.
LOOP AT all_clusters WHERE id = cvals-id.
node_line-id = cvals-id.
node_line-type = all_clusters-type.
EXIT.
ENDLOOP.
LOOP AT cvals.
MOVE-CORRESPONDING cvals TO field_tab.
APPEND field_tab.
ENDLOOP.
SORT field_tab.
ENDFORM. "form INIT_0104
*---------------------------------------------------------------------*
* FORM SET_TITLE_BOX *
*---------------------------------------------------------------------*
* Setzen der Titelbox f_r's Drucken *
*---------------------------------------------------------------------*
FORM set_title_box TABLES boxes STRUCTURE net_boxes
bvals STRUCTURE net_nvals
USING change_flag LIKE net_const-yes
header_text LIKE net_nvals-val.
boxes-id = 'B1'.
bvals-id = boxes-id.
IF change_flag = space.
* Box neu erzeugen
boxes-box_type = net_const-borderbox.
boxes-type = net_const-type_2. "Rahmentyp 2
APPEND boxes.
CALL FUNCTION 'CNET_MAKE_BOXES'
TABLES
boxes = boxes
bvals = bvals.
FREE: boxes, bvals.
ENDFORM. "SET_TITLE_BOX
*---------------------------------------------------------------------*
* FORM SET_TIME_EGG_TEXT *
*---------------------------------------------------------------------*
* Setzen Text im Zeitei *
*---------------------------------------------------------------------*
FORM set_time_egg_text.
time_egg_text = text-021.
CALL FUNCTION 'CNET_SET_TIMEEGG_TEXT'
EXPORTING
text = time_egg_text.
ENDFORM. "SET_TIME_EGG_TEXT
*---------------------------------------------------------------------*
* FORM UPDATE_CLUSTERS *
*---------------------------------------------------------------------*
* Update der Clustertabellen *
*---------------------------------------------------------------------*
FORM update_clusters TABLES clusters STRUCTURE cng_clustr
cvals STRUCTURE net_cvals
all_clusters STRUCTURE cng_clustr
all_cvals STRUCTURE net_cvals
nodes STRUCTURE cng_nodes
USING mes.
DATA: text_fl_values_1(10) TYPE c VALUE '1234567890',
text_fl_values_2(11) TYPE c VALUE '1234567890 '.
CASE mes.
WHEN space. "Laden
LOOP AT clusters. "Cluster
CLEAR all_clusters.
MOVE-CORRESPONDING clusters TO all_clusters.
APPEND all_clusters.
ENDLOOP.
LOOP AT cvals. "Attribute der Cluster
CLEAR all_cvals.
MOVE-CORRESPONDING cvals TO all_cvals.
APPEND all_cvals.
ENDLOOP.
WHEN OTHERS. "Update
LOOP AT cvals.
* Text
IF text_fl_values_1 CA cvals-fl(1)
AND text_fl_values_2 CA cvals-fl+1(1).
LOOP AT all_cvals WHERE id = cvals-id
AND fl = cvals-fl.
all_cvals-val = cvals-val.
MODIFY all_cvals.
ENDLOOP.
IF NOT sy-subrc IS INITIAL.
MOVE-CORRESPONDING cvals TO all_cvals.
APPEND all_cvals.
ENDIF.
* Typ
ELSEIF cvals-fl = net_const-type.
LOOP AT all_clusters WHERE id = cvals-id.
all_clusters-type = cvals-val.
MODIFY all_clusters.
ENDLOOP.
* AnhЇngen
ELSEIF cvals-fl = net_const-add_node "Knoten anhЇngen
OR cvals-fl = net_const-add_cluster. "Cluster anhЇngen
IF mes = net_const-ask_for_insert
AND cvals-fl = net_const-add_node.
READ TABLE nodes INDEX 1.
CHECK sy-subrc IS INITIAL.
cvals-val = nodes-id.
MODIFY cvals.
ENDIF.
LOOP AT all_cvals WHERE id = cvals-id
AND fl = cvals-fl
AND val = cvals-val.
EXIT.
ENDLOOP.
IF NOT sy-subrc IS INITIAL.
CLEAR all_cvals.
MOVE-CORRESPONDING cvals TO all_cvals.
APPEND all_cvals.
ENDIF.
* Knoten entfernen
ELSEIF cvals-fl = net_const-remove_node.
LOOP AT all_cvals WHERE id = cvals-id
AND fl = net_const-add_node
AND val = cvals-val.
DELETE all_cvals.
ENDLOOP.
* Cluster entfernen
ELSEIF cvals-fl = net_const-remove_cluster.
LOOP AT all_cvals WHERE id = cvals-id
AND fl = net_const-add_cluster
AND val = cvals-val.
DELETE all_cvals.
ENDLOOP.
* X-Position, Y-Position, Breite, H_he
ELSEIF cvals-fl = net_const-cluster_xpos
OR cvals-fl = net_const-cluster_ypos
OR cvals-fl = net_const-cluster_width
OR cvals-fl = net_const-cluster_height.
LOOP AT all_cvals WHERE id = cvals-id
AND fl = cvals-fl.
MODIFY all_cvals.
ENDLOOP.
IF NOT sy-subrc IS INITIAL.
CLEAR all_cvals.
MOVE-CORRESPONDING cvals TO all_cvals.
APPEND all_cvals.
ENDIF.
*---------------------------------------------------------------------*
* MODULE MODIFY_TAB_0100 INPUT *
*---------------------------------------------------------------------*
* Modifikation der Knoten bzw. Kanten der Grafik *
*---------------------------------------------------------------------*
MODULE modify_tab_0100 INPUT.
*---------------------------------------------------------------------*
* MODULE OK_CODE_0100 INPUT *
*---------------------------------------------------------------------*
* Auswertung des OK-CODES bei der Modifikation der Knoten/Kanten*
*---------------------------------------------------------------------*
MODULE ok_code_0100 INPUT.
save_ok-code = ok-code.
CLEAR ok-code.
CASE save_ok-code.
WHEN 'UPDA'.
CASE object_type.
WHEN net_const-node_object. "Knoten
CLEAR nvals_tab.
REFRESH nvals_tab.
LOOP AT field_tab.
CLEAR nvals_tab.
MOVE-CORRESPONDING field_tab TO nvals_tab.
APPEND nvals_tab.
IF field_tab-color <> space.
CLEAR nvals_tab.
READ TABLE nvals_tab INDEX sy-tabix.
WRITE nvals_tab-fl TO nvals_tab-val.
WRITE '/' TO nvals_tab-val+2(1).
WRITE field_tab-color TO nvals_tab-val+3.
CONDENSE nvals_tab-val NO-GAPS.
nvals_tab-fl = net_const-color.
APPEND nvals_tab.
ENDIF.
ENDLOOP.
WHEN net_const-line_object. "Kante
CLEAR lvals_tab.
REFRESH lvals_tab.
LOOP AT FIELD_TAB CURSOR ENTRY_ACT.
ENDLOOP.
*
PROCESS AFTER INPUT.
LOOP AT FIELD_TAB.
CHAIN.
FIELD FIELD_TAB-COLOR
SELECT * FROM TWCOL WHERE COLOR = FIELD_TAB-COLOR.
ENDCHAIN.
CHAIN.
FIELD: FIELD_TAB-FL.
FIELD: FIELD_TAB-VAL.
FIELD: FIELD_TAB-COLOR.
MODULE MODIFY_TAB_0100 ON CHAIN-REQUEST.
ENDCHAIN.
ENDLOOP.
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.
