topgp combobox动态下拉列表

用过TOPGP的都知道，画面上的下拉列表是写死在画面档上的，每个程序都要手动去维护一遍，很恶心很麻烦，
鼎捷也发现了这个问题，在T100上面就全部使用了动态的方式显示，具体的操作方式就是可以在前端维护一个基础档，然后程序抓取基础档上的资料动态显示到下拉列表中。这样做确实是方便了很多。其实TOPGP也是支持这种写法的，有天无聊我就自己开发了一个版本，使用起来确实挺方便，发出来给交流一下！
一，设计基础资料表
这个不多说，直接贴上表结构

1：单头档
ALTER TABLE DS.TC_GC_FILE
 DROP PRIMARY KEY CASCADE;

DROP TABLE DS.TC_GC_FILE CASCADE CONSTRAINTS;

CREATE TABLE DS.TC_GC_FILE
(
  TC_GC01  NUMBER(10)                           NOT NULL,  ---分类编码
  TC_GC02  VARCHAR2(80 BYTE),                                ---说明
    TC_GC03  VARCHAR2(250 BYTE)                               ---备注
)
TABLESPACE DBS1
PCTUSED    0
PCTFREE    10
INITRANS   1
MAXTRANS   255
STORAGE    (
            INITIAL          128K
            NEXT             1M
            MINEXTENTS       1
            MAXEXTENTS       UNLIMITED
            PCTINCREASE      0
            BUFFER_POOL      DEFAULT
           )
LOGGING 
NOCOMPRESS 
NOCACHE
NOPARALLEL
MONITORING;

CREATE UNIQUE INDEX DS.TC_GC_PK ON DS.TC_GC_FILE
(TC_GC01)
LOGGING
TABLESPACE DBS1
PCTFREE    10
INITRANS   2
MAXTRANS   255
STORAGE    (
            INITIAL          64K
            NEXT             1M
            MINEXTENTS       1
            MAXEXTENTS       UNLIMITED
            PCTINCREASE      0
            BUFFER_POOL      DEFAULT
           )
NOPARALLEL;

DROP SYNONYM ODS.TC_GC_FILE;

CREATE SYNONYM ODS.TC_GC_FILE FOR DS.TC_GC_FILE;

DROP SYNONYM DSALL.TC_GC_FILE;

CREATE SYNONYM DSALL.TC_GC_FILE FOR DS.TC_GC_FILE;

ALTER TABLE DS.TC_GC_FILE ADD (
  CONSTRAINT TC_GC_PK
 PRIMARY KEY
 (TC_GC01)
    USING INDEX 
    TABLESPACE DBS1
    PCTFREE    10
    INITRANS   2
    MAXTRANS   255
    STORAGE    (
                INITIAL          64K
                NEXT             1M
                MINEXTENTS       1
                MAXEXTENTS       UNLIMITED
                PCTINCREASE      0
               ));

GRANT INDEX, SELECT ON DS.TC_GC_FILE TO ODS;

GRANT INDEX, SELECT ON DS.TC_GC_FILE TO PUBLIC;

GRANT DELETE, INSERT, SELECT, UPDATE ON DS.TC_GC_FILE TO TIPTOPGP;

2：单身档

ALTER TABLE DS.TC_GD_FILE
 DROP PRIMARY KEY CASCADE;

DROP TABLE DS.TC_GD_FILE CASCADE CONSTRAINTS;

CREATE TABLE DS.TC_GD_FILE
(
  TC_GD01  NUMBER(10)                           NOT NULL,          ---编码
  TC_GD02  VARCHAR2(40 BYTE)                    NOT NULL,   ---编码值
  TC_GD03  VARCHAR2(250 BYTE),                                       ---说明
  TC_GD04  NUMBER(5)                                                          --显示顺序
)
TABLESPACE DBS1
PCTUSED    0
PCTFREE    10
INITRANS   1
MAXTRANS   255
STORAGE    (
            INITIAL          128K
            NEXT             1M
            MINEXTENTS       1
            MAXEXTENTS       UNLIMITED
            PCTINCREASE      0
            BUFFER_POOL      DEFAULT
           )
LOGGING 
NOCOMPRESS 
NOCACHE
NOPARALLEL
MONITORING;

CREATE UNIQUE INDEX DS.TC_GD_PK ON DS.TC_GD_FILE
(TC_GD01, TC_GD02)
LOGGING
TABLESPACE DBS1
PCTFREE    10
INITRANS   2
MAXTRANS   255
STORAGE    (
            INITIAL          64K
            NEXT             1M
            MINEXTENTS       1
            MAXEXTENTS       UNLIMITED
            PCTINCREASE      0
            BUFFER_POOL      DEFAULT
           )
NOPARALLEL;

DROP SYNONYM ODS.TC_GD_FILE;

CREATE SYNONYM ODS.TC_GD_FILE FOR DS.TC_GD_FILE;

DROP SYNONYM DSALL.TC_GD_FILE;

CREATE SYNONYM DSALL.TC_GD_FILE FOR DS.TC_GD_FILE;

ALTER TABLE DS.TC_GD_FILE ADD (
  CONSTRAINT TC_GD_PK
 PRIMARY KEY
 (TC_GD01, TC_GD02)
    USING INDEX 
    TABLESPACE DBS1
    PCTFREE    10
    INITRANS   2
    MAXTRANS   255
    STORAGE    (
                INITIAL          64K
                NEXT             1M
                MINEXTENTS       1
                MAXEXTENTS       UNLIMITED
                PCTINCREASE      0
               ));

GRANT INDEX, SELECT ON DS.TC_GD_FILE TO ODS;

GRANT INDEX, SELECT ON DS.TC_GD_FILE TO PUBLIC;

GRANT DELETE, INSERT, SELECT, UPDATE ON DS.TC_GD_FILE TO TIPTOPGP;

二：添加基础资料维护作业
这个也没什么好说的，开发一个最简单的双档维护程序就行了，贴上一张效果图

三：新增公用函数
这个函数可以在lib/4gl目录下新增，这样每个程序就能自动链接了
我是新增了一个这个函数cl_set_combo_items.4gl程序里面新增了一个函数cl_set_combo，主要用这个函数就行了，直接贴代码

# Prog. Version..: '5.25.03-11.07.14(00000)'     #
#
# Program name...: cl_set_combo_items.4gl
# Descriptions...: 動態設定ComboBox的Item.
# Date & Author..: 03/07/02 by Hiko
# Usage..........: CALL cl_set_combo_items("oea08", "1,2", "Local Order,Export Order")
# Modify.........: No.FUN-640240 06/05/17 Echo 自動執行確認功能
# Modify...... ..: No.FUN-690005 06/09/05 By chen 類型轉換
# Modify.........: No.FUN-6C0017 06/12/13 By jamie 程式開頭增加'database ds'
# Modify.........: No.TQC-740146 07/04/24 By Echo 判斷是否背景作業，條件需再加上 g_gui_type 
# Modify.........: No.FUN-7C0053 07/12/17 By alex 修改說明only

IMPORT os

DATABASE ds        #FUN-6C0017   #FUN-7C0053

GLOBALS "../../config/top.global"

# Descriptions...: 設定ComboBox的Item.
# Date & Author..: 2003/07/02 by Hiko
# Input Parameter: ps_field_name STRING ComboBox所對應的欄位名稱
#                  ps_values STRING Item所對應的儲存值字串(中間以逗點分隔)
#                  ps_items SMALLINT Item字串(中間以逗點分隔)
# Return Code....: void
# Modify.........: MOD-520002 alex 刪除傳入值的空白尾碼
# Modify.........: MOD-540134 alex 同上

FUNCTION cl_set_combo_items(ps_field_name, ps_values, ps_items)
  DEFINE ps_field_name,ps_values,ps_items STRING
  DEFINE lcbo_target ui.ComboBox
  DEFINE lst_values,lst_items base.StringTokenizer
  DEFINE ls_msg     LIKE ze_file.ze03          #No.FUN-690005   VARCHAR(100)

  WHENEVER ERROR CALL cl_err_msg_log

  #FUN-640240
  #IF g_bgjob = 'Y' THEN
  IF g_bgjob = 'Y' AND g_gui_type NOT MATCHES "[13]"  THEN    #TQC-740146

     RETURN
  END IF
  #END FUN-640240

   #MOD-540134
  LET ps_field_name=ps_field_name.trim()
   #MOD-520002
  LET ps_values=ps_values.trim()
  LET ps_items=ps_items.trim()

  LET lcbo_target = ui.ComboBox.forName(ps_field_name)

  IF lcbo_target IS NULL THEN
    SELECT ze03 INTO ls_msg FROM ze_file WHERE ze01 = 'lib-031' AND ze02 = g_lang
    CALL cl_err(ps_field_name, "lib-031", 1)
    RETURN
  ELSE
    CALL lcbo_target.clear()
  END IF

  LET lst_values = base.StringTokenizer.create(ps_values, ",")
  LET lst_items = base.StringTokenizer.create(ps_items, ",")

  WHILE lst_values.hasMoreTokens()
    CALL lcbo_target.addItem(lst_values.nextToken(), lst_items.nextToken())
  END WHILE
END FUNCTION

FUNCTION cl_set_combo(p_field,p_gc01)
   DEFINE p_field   LIKE type_file.chr1000,           #No.FUN-690005  VARCHAR(10)
          p_gc01    LIKE type_file.num10         #No.FUN-690005  VARCHAR(5)  #No.FUN-690103

   DEFINE l_sql     STRING
   DEFINE l_value1  LIKE type_file.chr100 
   DEFINE l_value2  LIKE type_file.chr100
   DEFINE lcbo_target ui.ComboBox
   DEFINE ls_msg     LIKE ze_file.ze03          #No.FUN-690005   VARCHAR(100) 

   WHENEVER ERROR CALL cl_err_msg_log

  IF g_bgjob = 'Y' AND g_gui_type NOT MATCHES "[13]"  THEN    #TQC-740146

     RETURN
  END IF  

#LET p_field = p_field.trim()
LET lcbo_target = ui.ComboBox.forName(p_field)
  IF lcbo_target IS NULL THEN
    SELECT ze03 INTO ls_msg FROM ze_file WHERE ze01 = 'lib-031' AND ze02 = g_lang
    CALL cl_err(p_field, "lib-031", 1)
    RETURN
  ELSE
    CALL lcbo_target.clear()
  END IF

 LET l_sql = " SELECT tc_gd02,tc_gd02||':'||tc_gd03 FROM tc_gd_file WHERE tc_gd01 = ",p_gc01, 
         " order by tc_gd04,tc_gd02"

   PREPARE eepc100_b_ecamuc_pd FROM l_sql
   DECLARE eepc100_b_ecamuc_cs CURSOR FOR eepc100_b_ecamuc_pd

   FOREACH eepc100_b_ecamuc_cs INTO l_value1,l_value2
      CALL lcbo_target.addItem(l_value1,l_value2)
   END FOREACH 

END FUNCTION

四：调用函数
调用的时候就特别简单了，直接在CALL cl_ui_init() 下面CALL cl_set_combo(‘画面党上的命名’,编码) ，如下图

以上，就是制作动态下拉列表的全部步骤，这些做完了，就可以随心所欲的在前端维护下拉列表值了，再也不用去改画面档了！