基础知识:01.03.01.快速开始篇(4fd+4gl+数据库:数据交互)
本页目录:
- 1、语法
- 2、实列
- 2.1、编写程序
- 2.2、测试
语法
定义全局变量
# 分页需要用到的变量
DEFINE g_curs_index LIKE type_file.num10
DEFINE g_row_count LIKE type_file.num10
DEFINE g_msg LIKE ze_file.ze03
# 查询到的数据存储变量
DEFINE g_rows RECORD
poz01 LIKE poz_file.poz01,
poz011 LIKE poz_file.poz011,
poy04 LIKE poy_file.poy04,
poy03 LIKE poy_file.poy03,
pmc03 LIKE pmc_file.pmc03,
poy11 LIKE poy_file.poy11
END RECORD
查询数据的方法体
FUNCTION q380_q()
DEFINE l_sql string
INITIALIZE g_rows.* TO NULL
LET l_sql ="SELECT poz01,poz011,poy04,poy03,pmc03,poy11 ",
"FROM POZ_FILE ",
"INNER JOIN POY_FILE ON poy01=poz01 ",
"INNER JOIN PMC_FILE ON pmc01=poy03 ",
"WHERE LOWER(poy04) <> '",g_dbs CLIPPED,"'",
" AND pozacti='Y' ",
" AND poy11 IS NOT NULL ",
" AND poz011='2' ",
"GROUP BY poz01,poz011,poy04,poy03,pmc03,poy11 "
PREPARE q380_prepare FROM l_sql
DECLARE q380_paging SCROLL CURSOR WITH HOLD FOR q380_prepare
LET g_row_count = 0
LET g_curs_index=1
FOREACH q380_paging INTO g_rows.*
IF cl_null (g_rows.poz01) THEN
CONTINUE FOREACH
END IF
LET g_row_count = g_row_count + 1
END FOREACH
OPEN q380_paging
IF SQLCA.sqlcode THEN
CALL cl_err('',SQLCA.sqlcode,0)
ELSE
CALL paging_fetch('F')
END IF
END FUNCTION
分页的方法体
FUNCTION paging_fetch(p_flag)
DEFINE p_flag LIKE type_file.chr1
DEFINE l_abso LIKE type_file.num10
CASE p_flag
WHEN 'F'
LET g_curs_index = 1
FETCH FIRST q380_paging INTO g_rows.*
WHEN 'N'
LET g_curs_index = g_curs_index + 1
FETCH NEXT q380_paging INTO g_rows.*
WHEN 'P'
LET g_curs_index = g_curs_index - 1
FETCH PREVIOUS q380_paging INTO g_rows.*
WHEN 'L'
LET g_curs_index = g_row_count
FETCH LAST q380_paging INTO g_rows.*
WHEN '/'
CALL cl_getmsg('fetch',g_lang) RETURNING g_msg
LET INT_FLAG = FALSE
PROMPT g_msg CLIPPED,': ' FOR l_abso
ON IDLE g_idle_seconds
CALL cl_on_idle()
END PROMPT
IF INT_FLAG THEN
LET INT_FLAG = 0
EXIT CASE
END IF
LET g_curs_index =l_abso
IF g_row_count <l_abso THEN
LET g_curs_index =g_row_count
END IF
FETCH ABSOLUTE l_abso q380_paging INTO g_rows.*
END CASE
IF g_row_count != 0 THEN
CALL fgl_set_arr_curr(1)
END IF
CALL cl_navigator_setting(g_curs_index, g_row_count)
CALL q380_show()
END FUNCTION
将数据展现到画面
FUNCTION q380_show()
# 单头
DISPLAY g_rows.* TO FORMONLY.poz01,
FORMONLY.poz011,
FORMONLY.poy04,
FORMONLY.poy03,
FORMONLY.pmc03,
FORMONLY.poy11
#单尾
DISPLAY g_row_count TO FORMONLY.cn2
DISPLAY g_curs_index TO FORMONLY.cnt
END FUNCTION
实列
编写程序
- 需求:按不同多角流程代码进行分页
4fd
- 代码:cxmq380.4fd
<?xml version="1.0" encoding="UTF-8" ?>
<ManagedForm gstVersion="22800" name="ManagedForm" uid="{a0a998a7-586e-40c7-a945-556afe07247f}">
<AGSettings/>
<Record additionalTables="" joinLeft="" joinOperator="" joinRight="" name="Undefined" order="" uid="{f7d1882a-c426-4abd-9aa0-16e2294dc3b3}" where="">
<RecordField colName="" fieldIdRef="1" name="oea904" sqlTabName="" sqlType="VARCHAR" table_alias_name="" uid="{7b67776f-e187-43dd-804e-a61fc2d0d241}"/>
<RecordField colName="" fieldIdRef="2" name="cnt" sqlTabName="" table_alias_name="" uid="{92852dad-3335-479e-8af4-6954a553c1fe}"/>
<RecordField colName="" fieldIdRef="3" name="cn2" sqlTabName="" table_alias_name="" uid="{bbd73337-0489-4b87-b23f-ec237671c69e}"/>
</Record>
<Record additionalTables="" joinLeft="" joinOperator="" joinRight="" name="Record1" order="" uid="{23621e56-7e71-42f9-bb33-5809559846b5}" where=""/>
<Record additionalTables="" joinLeft="" joinOperator="" joinRight="" name="Record2" order="" uid="{16ee7f58-47fc-4564-b685-b1eb425b2ad3}" where=""/>
<Form gridHeight="20" gridWidth="159" name="apmq380" text="apmq380">
<Grid gridHeight="17" gridWidth="153" name="Grid1" posX="2" posY="0">
<Group gridHeight="7" gridWidth="148" name="Group1" posX="2" posY="1" text="Group1">
<Label posX="1" posY="1" text="oea904"/>
<ButtonEdit action="controlp" aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" case="none" colName="" columnCount="" comment="oea_file.oea904" fieldId="1" gridHeight="1" gridWidth="27" image="zoom" name="oea904" noEntry="true" notNull="true" posX="8" posY="1" required="true" rowCount="" sqlTabName="" sqlType="VARCHAR" stepX="" stepY="" tabIndex="1" table_alias_name="" title="ButtonEdit1" verify="true" widget="ButtonEdit"/>
</Group>
<Group gridHeight="3" gridWidth="148" name="Group2" posX="2" posY="8" text="Group2">
<HLine gridWidth="10" name="hl1" posX="1" posY="1"/>
<Label posX="12" posY="1" text="cnt"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" colName="" columnCount="" fieldId="2" gridHeight="1" gridWidth="6" name="cnt" posX="17" posY="1" rowCount="" sqlTabName="" stepX="" stepY="" tabIndex="2" table_alias_name="" title="Edit1" widget="Edit"/>
<HLine gridWidth="10" name="hl1607" posX="123" posY="1"/>
<Label posX="135" posY="1" text="cn"/>
<Edit aggregateColName="" aggregateName="" aggregateTableAliasName="" aggregateTableName="" colName="" columnCount="" fieldId="3" gridHeight="1" gridWidth="6" justify="right" name="cn2" posX="140" posY="1" rowCount="" sqlTabName="" stepX="" stepY="" tabIndex="3" table_alias_name="" title="Edit1" widget="Edit"/>
</Group>
</Grid>
</Form>
<DiagramLayout>
<![CDATA[AAAAAgAAAEwAewBmADcAZAAxADgAOAAyAGEALQBjADQAMgA2AC0ANABhAGIAZAAtADkAYQBhADAALQAxADYAZQAyADIAOQA0AGQAYwAzAGIAMwB9AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAEwAewA3AGIANgA3ADcANwA2AGYALQBlADEAOAA3AC0ANAAzAGQAZAAtADgAMAA0AGUALQBhADYAMQBmAGMAMgBkADAAZAAyADQAMQB9QCQAAAAAAABAQoAAAAAAAAAAAAAAAAAAAQAAAEwAewAxADYAZQBlADcAZgA1ADgALQA0ADcAZgBjAC0ANAA1ADYANAAtAGIANgA4ADUALQBiADEAZQBiADQAMgA1AGIAMgBhAGQAMwB9QDQAAAAAAABANAAAAAAAAAAAAAAAAAAAAQAAAEwAewA5ADIAOAA1ADIAZABhAGQALQAzADMAMwA1AC0ANAA3ADkAZQAtADgAYQBmADQALQA2ADkANQA0AGEANQA1ADMAYwAxAGYAZQB9QCQAAAAAAABATYAAAAAAAAAAAAAAAAAAAQAAAEwAewBiAGIAZAA3ADMAMwAzADcALQAwADQAOAA5AC0ANABiADgANwAtAGIAMgAzAGYALQBlAGMAMgAzADcANgA3ADEAYwA2ADkAZQB9QCQAAAAAAABAVEAAAAAAAAAAAAAAAAAAAQAAAEwAewAyADMANgAyADEAZQA1ADYALQA3AGUANwAxAC0ANAAyAGYAOQAtAGIAYgAzADMALQA1ADgAMAA5ADUANQA5ADgANAA2AGIANQB9QCQAAAAAAABAJAAAAAAAAAAAAAAAAAAAAQ==]]>
</DiagramLayout>
</ManagedForm>
4gl
-
在q_per添加开窗查询:q_oea904 。参考:03.01.03.组件篇(4fd+4gl 新增:查询+输入框 界面化方式)
-
代码:cxmq380.4gl
# Prog. Version..: '5.00.03-2023.11.16(00000)'
# Pattern name...: cxmq380.4gl
# Descriptions...: 多角订单出货未交明细查询
# Author..: DKLi
# Date: 2023.11.17
DATABASE ds
GLOBALS "../../config/top.global"
# 4gl变量
DEFINE g_curs_index LIKE type_file.num10
DEFINE g_row_count LIKE type_file.num10
DEFINE g_msg LIKE ze_file.ze03
DEFINE g_rows RECORD
oea904 LIKE oea_file.oea904
END RECORD
# 4fd的变量
DEFINE tm RECORD
wc string
END RECORD
# Pattern name...: MAIN
# Descriptions...: 主函数
MAIN
# 定義局域變量,本文函數可以用
DEFINE p_row,p_col LIKE type_file.num5
LET p_row = ARG_VAL(1)
LET p_col = ARG_VAL(2)
LET tm.wc = ARG_VAL(3)
# 改變一些系統缺省值
OPTIONS
FORM LINE FIRST + 2, #畫面開始的位置
MESSAGE LINE LAST, #訊息顯示的位置
PROMPT LINE LAST, #提示訊息的位置
INPUT NO WRAP #輸入的方式: 不打轉
DEFER INTERRUPT #擷取中斷鍵
# cl_user( ) 主要在抓取系統中與『個人設定』
IF (NOT cl_user()) THEN
EXIT PROGRAM
END IF
# 當發生 SQL 錯誤時,系統會CALL cl_err_msg_log( )
WHENEVER ERROR CALL cl_err_msg_log
# cl_setup( ) 主要在抓取系統中與『模組設定』相關的變數值資料,
# 如這個模組所必需的全域變數等等
IF (NOT cl_setup("CXM")) THEN
EXIT PROGRAM
END IF
CALL cl_used(g_prog,g_time,1) RETURNING g_time -- 計算使用時間 (進入時間)
# 打開窗口
LET p_row = 5 LET p_col = 10 -- 給變量賦值
OPEN WINDOW q380_w AT p_row,p_col WITH FORM "cxm/42f/cxmq380"
ATTRIBUTE (STYLE = g_win_style CLIPPED)
CALL cl_ui_init() -- 初始化程序設定
CALL q380_menu() -- 調用q380_menu函數
CLOSE WINDOW q380_w
CALL cl_used(g_prog,g_time,2) RETURNING g_time -- 計算使用時間 (退出時間)
END MAIN
# Pattern name...: q380_menu()
# Descriptions...:画面的ToolBar的设置函数
FUNCTION q380_menu()
# ToolBar的設置
MENU ""
BEFORE MENU
CALL cl_navigator_setting(g_curs_index, g_row_count) -- 重新設定TOOLBAR上的『上筆、跳筆、下筆』等五個按鍵是否可用 / 不可用。
ON ACTION query -- 查询按钮
CALL q380_s()
ON IDLE g_idle_seconds
CALL cl_on_idle()
CONTINUE MENU
ON ACTION first -- 第一笔按钮
CALL paging_fetch('F')
ON ACTION previous --上笔
CALL paging_fetch('P')
ON ACTION jump --指定笔
CALL paging_fetch('/')
ON ACTION next --下笔
CALL paging_fetch('N')
ON ACTION last -- 末一笔
CALL paging_fetch('L')
ON ACTION locale --语言按钮
CALL cl_dynamic_locale() #切换
CALL cl_show_fld_cont() #显示
ON ACTION help --帮助/说明按钮
CALL cl_show_help()
ON ACTION about --程式咨询按钮
CALL cl_about()
ON ACTION controlg --程式切换
CALL cl_cmdask()
ON ACTION exit -- 離開按鈕
LET INT_FLAG = FALSE
EXIT MENU
ON ACTION close -- 窗口右上角x按钮
LET INT_FLAG=FALSE
EXIT MENU
END MENU
END FUNCTION
# Pattern name...: q380_q()
# Descriptions...: 获取4fd传来的数据
FUNCTION q380_s()
INITIALIZE tm.wc TO NULL
CALL q380_set_entry("q")
CONSTRUCT BY NAME tm.wc ON oea904
BEFORE CONSTRUCT
CALL cl_qbe_init()
ON ACTION CONTROLP
CASE
WHEN INFIELD(oea904)
CALL cl_init_qry_var()
LET g_qryparam.state = 'c'
LET g_qryparam.form = "q_oea904"
CALL cl_create_qry() RETURNING g_qryparam.multiret
DISPLAY g_qryparam.multiret TO oea904
NEXT FIELD oea904
OTHERWISE EXIT CASE
END CASE
ON ACTION locale
CALL cl_dynamic_locale()
CALL cl_show_fld_cont()
EXIT CONSTRUCT
ON IDLE g_idle_seconds
CALL cl_on_idle()
CONTINUE CONSTRUCT
ON ACTION about
CALL cl_about()
ON ACTION controlg
CALL cl_cmdask()
ON ACTION help
CALL cl_show_help()
END CONSTRUCT
CALL q380_q()
END FUNCTION
# Pattern name...: q380_set_entry(p_cmd)
# Descriptions...: 设置输入框可以编辑
FUNCTION q380_set_entry(p_cmd)
DEFINE p_cmd LIKE type_file.chr1
IF p_cmd = 'q' THEN
CALL cl_set_comp_entry("oea904",TRUE)
END IF
END FUNCTION
# Pattern name...: q380_q()
# Descriptions...: 根据4fd输入的信息,查询后台数据
FUNCTION q380_q()
DEFINE l_sql string
INITIALIZE g_rows.* TO NULL
LET l_sql ="SELECT oea904 ",
"FROM OEA_FILE ",
"INNER JOIN OEB_FILE ON oeb01=oea01 ",
"INNER JOIN IMA_FILE ON ima01=oeb04 ",
"INNER JOIN POZ_FILE ON poz01=oea904 ",
"LEFT JOIN ( ",
" SELECT ogb31,ogb32,SUM(ogb12) sum_ogb12 ",
" FROM OGA_FILE ",
" INNER JOIN OGB_FILE ON OGB01=OGA01 ",
" WHERE ogaconf='Y' AND oga55='1' ",
" GROUP BY ogb31,ogb32 ",
" ) a ON a.ogb31=oea01 AND a.ogb32=oeb03 ",
"WHERE ",tm.wc CLIPPED,
" AND OEACONF = 'Y' ",
" AND oea11 IN ('6','7') ",
" AND oea49 ='1' ",
" AND oeb12-a.sum_ogb12>0 ",
"GROUP BY oea904"
PREPARE q380_prepare FROM l_sql
DECLARE q380_paging SCROLL CURSOR WITH HOLD FOR q380_prepare
LET g_row_count = 0
LET g_curs_index=1
FOREACH q380_paging INTO g_rows.*
IF cl_null (g_rows.oea904) THEN
CONTINUE FOREACH
END IF
LET g_row_count = g_row_count + 1
END FOREACH
OPEN q380_paging
IF SQLCA.sqlcode THEN
CALL cl_err('',SQLCA.sqlcode,0)
INITIALIZE tm.wc TO NULL
ELSE
CALL paging_fetch('F')
END IF
END FUNCTION
# Pattern name...: q380_show()
# Descriptions...: 將數據顯示到畫面
FUNCTION q380_show()
DISPLAY g_row_count TO FORMONLY.cn2
DISPLAY g_curs_index TO FORMONLY.cnt
DISPLAY g_rows.* TO FORMONLY.oea904
END FUNCTION
# Pattern name...: paging_fetch(p_flag)
# Descriptions...: 分页显示
FUNCTION paging_fetch(p_flag)
DEFINE p_flag LIKE type_file.chr1
DEFINE l_abso LIKE type_file.num10
CASE p_flag
WHEN 'F'
LET g_curs_index = 1
FETCH FIRST q380_paging INTO g_rows.*
WHEN 'N'
LET g_curs_index = g_curs_index + 1
FETCH NEXT q380_paging INTO g_rows.*
WHEN 'P'
LET g_curs_index = g_curs_index - 1
FETCH PREVIOUS q380_paging INTO g_rows.*
WHEN 'L'
LET g_curs_index = g_row_count
FETCH LAST q380_paging INTO g_rows.*
WHEN '/'
CALL cl_getmsg('fetch',g_lang) RETURNING g_msg
LET INT_FLAG = FALSE
PROMPT g_msg CLIPPED,': ' FOR l_abso
ON IDLE g_idle_seconds
CALL cl_on_idle()
END PROMPT
IF INT_FLAG THEN
LET INT_FLAG = 0
EXIT CASE
END IF
LET g_curs_index =l_abso
IF g_row_count <l_abso THEN
LET g_curs_index =g_row_count
END IF
FETCH ABSOLUTE l_abso q380_paging INTO g_rows.*
END CASE
IF g_row_count != 0 THEN
CALL fgl_set_arr_curr(1)
END IF
CALL cl_navigator_setting(g_curs_index, g_row_count)
CALL q380_show()
END FUNCTION
测试
# 使用sftp 上传
cd /u1/toptest/topcust/cxm/4fd
put cxmq380.4fd
cd /u1/toptest/topcust/cxm/4gl
put cxmq380.4gl
# 使用ssh 编译
cd /u1/toptest/topcust/cxm/4fd
r.f2 cxmq380 2 c
cd /u1/toptest/topcust/cxm/4gl
r.c2 cxmq380
r.l2 cxmq380
exe2 cxmq380
- 输入的内容是:PTVBL1|SHKBL1
-- 找最小笔数的oea904做测试
SELECT oea904,COUNT(oea904)
FROM OEA_FILE
INNER JOIN OEB_FILE ON oeb01=oea01
INNER JOIN IMA_FILE ON ima01=oeb04
INNER JOIN POZ_FILE ON poz01=oea904
WHERE OEACONF = 'Y'
AND oea11 IN ('6','7')
GROUP BY oea904
ORDER BY COUNT(oea904)