QAD 实现批量导入菜单(GUI版) -Index4-UIConfig
1.对批量导入的菜单进行设置
/*------------------------------------------------------------------------
File : xxguicimset.p
Purpose : GUI CIMLOAD MENU CONFIG
Syntax :
Description :
Author(s) : TERRENCE ZHANG
Created : Sat Oct 29 13:38:56 CST 2016
Notes :
----------------------------------------------------------------------*/
&SCOPED-DEFINE WIDTHLMT 56
/*76 设置最大的合计宽度*/
{mfdtitle.i}
DEFINE VARIABLE clsname AS CHARACTER FORMAT "x(16)" NO-UNDO. /*类名*/
DEFINE VARIABLE menuname AS CHARACTER FORMAT "x(16)" NO-UNDO.
DEFINE VARIABLE contrname AS CHARACTER FORMAT "x(16)" INIT "xxcimgeneral.p" NO-UNDO.
DEFINE VARIABLE viewname AS CHARACTER FORMAT "x(16)" INIT "cimframe.cls" NO-UNDO.
DEFINE VARIABLE frametitle AS CHARACTER FORMAT "x(50)" NO-UNDO.
DEFINE VARIABLE bptitle AS CHARACTER FORMAT "x(50)" NO-UNDO.
DEFINE VARIABLE datelab AS CHARACTER FORMAT "x(12)" NO-UNDO.
DEFINE VARIABLE showdate AS LOGICAL NO-UNDO.
DEFINE VARIABLE togbxlab AS CHARACTER FORMAT "x(12)" NO-UNDO.
DEFINE VARIABLE showtogbx AS LOGICAL NO-UNDO.
DEFINE VARIABLE togbx AS LOGICAL NO-UNDO.
DEFINE VARIABLE togbxmsgf AS CHARACTER FORMAT "x(50)" NO-UNDO.
DEFINE VARIABLE togbxmsgt AS CHARACTER FORMAT "x(50)" NO-UNDO.
DEFINE VARIABLE labellist AS CHARACTER FORMAT "x(16)" EXTENT 7 NO-UNDO.
DEFINE VARIABLE formatlist AS DECIMAL EXTENT 7 INIT 8 NO-UNDO.
DEFINE VARIABLE visiblelist AS LOGICAL EXTENT 7 INIT YES NO-UNDO.
DEFINE VARIABLE totwidth AS DECIMAL NO-UNDO.
DEFINE VARIABLE i AS INTEGER INITIAL 1 NO-UNDO.
DEFINE VARIABLE choice AS LOGICAL INIT YES NO-UNDO.
FORM /*GUI*/
RECT-FRAME AT ROW 1.4 COLUMN 1.25
RECT-FRAME-LABEL AT ROW 1 COLUMN 3 NO-LABEL
SKIP(.5) /*GUI*/
clsname COLON 20 LABEL "MODEL-PROGRAM"
menuname COLON 55 LABEL "MENU-PROGRAM" SKIP(.2)
contrname COLON 20 LABEL "CONTR-PROGRAM"
viewname COLON 55 LABEL "VIEW-PROGRAM" SKIP(.2)
frametitle COLON 15 LABEL "MAIN TITLE" SKIP(.1)
bptitle COLON 15 LABEL "BROWSE NAME" SKIP(.1)
datelab COLON 15 LABEL "DATE LABEL"
showdate COLON 45 LABEL "SHOW DATE" SKIP(.1)
togbxlab COLON 15 LABEL "TOGBX LABEL"
showtogbx COLON 45 LABEL "SHOW TOGBX"
togbx COLON 70 LABEL "CHECKED"
SKIP(.1)
togbxmsgf COLON 15 LABEL "UNCHECKED MSG" SKIP(.1)
togbxmsgt COLON 15 LABEL "CHECKED MSG" SKIP(.2)
labellist[1] COLON 15 LABEL "LABEL[1]"
formatlist[1] COLON 45 LABEL "WIDTH[1]"
visiblelist[1] COLON 70 LABEL "VISIB[1]" SKIP
labellist[2] COLON 15 LABEL "LABEL[2]"
formatlist[2] COLON 45 LABEL "WIDTH[2]"
visiblelist[2] COLON 70 LABEL "VISIB[2]" SKIP
labellist[3] COLON 15 LABEL "LABEL[3]"
formatlist[3] COLON 45 LABEL "WIDTH[3]"
visiblelist[3] COLON 70 LABEL "VISIB[3]" SKIP
labellist[4] COLON 15 LABEL "LABEL[4]"
formatlist[4] COLON 45 LABEL "WIDTH[4]"
visiblelist[4] COLON 70 LABEL "VISIB[4]" SKIP
labellist[5] COLON 15 LABEL "LABEL[5]"
formatlist[5] COLON 45 LABEL "WIDTH[5]"
visiblelist[5] COLON 70 LABEL "VISIB[5]" SKIP
labellist[6] COLON 15 LABEL "LABEL[6]"
formatlist[6] COLON 45 LABEL "WIDTH[6]"
visiblelist[6] COLON 70 LABEL "VISIB[6]" SKIP
labellist[7] COLON 15 LABEL "LABEL[7]"
formatlist[7] COLON 45 LABEL "WIDTH[7]"
visiblelist[7] COLON 70 LABEL "VISIB[7]"
SKIP(.5)
WITH FRAME a SIDE-LABELS WIDTH 80 ATTR-SPACE
NO-BOX THREE-D /*GUI*/.
DEFINE VARIABLE F-a-title AS CHARACTER.
F-a-title = "GUI CIMLOAD MENU CONFIG".
RECT-FRAME-LABEL:SCREEN-VALUE IN FRAME a = F-a-title.
RECT-FRAME-LABEL:WIDTH-PIXELS IN FRAME a = FONT-TABLE:GET-TEXT-WIDTH-PIXELS(RECT-FRAME-LABEL:SCREEN-VALUE IN FRAME a + " ", RECT-FRAME-LABEL:FONT).
RECT-FRAME:HEIGHT-PIXELS IN FRAME a = FRAME a:HEIGHT-PIXELS - RECT-FRAME:Y IN FRAME a - 2.
RECT-FRAME:WIDTH-CHARS IN FRAME a = FRAME a:WIDTH-CHARS - .5. /*GUI*/
mainloop:
REPEAT WITH FRAME a ON ENDKEY UNDO mainloop,LEAVE mainloop:
UPDATE
clsname VALIDATE(clsname NE "","Class name cannot be blank!")
HELP "Please enter the Class name"
WITH FRAME a
EDITING:
/* FIND NEXT/PREVIOUS RECORD */
{mfnp.i xxqcfg_mstr clsname "xxqcfg_type = 'GUICIMSET' AND xxqcfg_chr01" clsname xxqcfg_chr01 xxqcfg_type}
IF recno <> ? THEN DO:
DO i = 1 TO 7:
ASSIGN
labellist[i] = ENTRY(i,xxqcfg_chr16)
formatlist[i] = DECIMAL(ENTRY(i,xxqcfg_chr17))
visiblelist[i] = LOGICAL(ENTRY(i,xxqcfg_chr18)).
END.
DISP
xxqcfg_chr10 @ menuname
xxqcfg_chr11 @ viewname
xxqcfg_chr12 @ contrname
xxqcfg_chr01 @ clsname
xxqcfg_chr02 @ frametitle
xxqcfg_chr03 @ bptitle
xxqcfg_chr04 @ datelab
xxqcfg_log02 @ togbx
xxqcfg_log03 @ showdate
xxqcfg_log04 @ showtogbx
xxqcfg_chr05 @ togbxlab
xxqcfg_chr08 @ togbxmsgf
xxqcfg_chr09 @ togbxmsgt
labellist
formatlist
visiblelist
WITH FRAME a.
recno = ?.
END.
END. /* EDITING */
clsname = ENTRY(1,clsname,".").
IF SEARCH(clsname + ".cls") = ? AND SEARCH(clsname + ".r") = ? THEN
DO:
MESSAGE "MODEL-PROGRAM " + clsname + ".cls" + " does not exist" VIEW-AS ALERT-BOX ERROR.
UNDO,RETRY.
END.
RUN dispset.
UPDATE
contrname HELP "F6=Re-compile Menu Program"
/*viewname*/ GO-ON ("F6")
WITH FRAME a.
IF LASTKEY = KEYCODE("F6") /*手动重新编译*/
THEN
DO:
UPDATE menuname HELP "Press Key INSERT to Compile Menu Program" GO-ON("insert") WITH FRAME a.
IF LASTKEY = KEYCODE("insert") THEN
RUN compile-rcode(REPLACE(clsname,"cim","")).
END.
loop-b:
REPEAT ON ENDKEY UNDO loop-b,LEAVE loop-b:
SET
frametitle
bptitle
datelab
showdate
togbxlab
showtogbx
togbx
togbxmsgf
togbxmsgt
labellist [1 FOR 7]
formatlist [1 FOR 7]
visiblelist[1 FOR 7]
GO-ON ("F5" "CTRL-D")
WITH FRAME a.
IF LASTKEY = KEYCODE("F5") OR LASTKEY = KEYCODE("CTRL-D") THEN
DO:
MESSAGE "Confirm to delete?" VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE choice.
IF choice THEN
DO:
FOR FIRST xxqcfg_mstr WHERE xxqcfg_type = "GUICIMSET" AND xxqcfg_chr01 = clsname EXCLUSIVE-LOCK:
DELETE xxqcfg_mstr.
MESSAGE "Deleted".
END.
END.
NEXT mainloop.
END.
/*
totwidth = 0.
DO i = 1 TO EXTENT(formatlist):
IF visiblelist[i] = NO THEN NEXT.
totwidth = totwidth + formatlist[i].
END.
IF totwidth NE {&WIDTHLMT} THEN
DO:
MESSAGE 'The Total Width should be {&WIDTHLMT}' VIEW-AS ALERT-BOX WARNING. /*宽度总和得是56*/
UNDO loop-b,RETRY loop-b.
END.
*/
FIND FIRST xxqcfg_mstr WHERE xxqcfg_type = "GUICIMSET" AND xxqcfg_chr01 = clsname NO-ERROR.
IF NOT AVAILABLE xxqcfg_mstr THEN DO:
CREATE xxqcfg_mstr.
ASSIGN xxqcfg_type = "GUICIMSET"
xxqcfg_id = GUID
xxqcfg_chr01 = clsname
xxqcfg_userid = global_userid
xxqcfg_create = NOW.
END.
ASSIGN xxqcfg_chr02 = frametitle
xxqcfg_chr03 = bptitle
xxqcfg_chr04 = datelab
xxqcfg_log02 = togbx
xxqcfg_log03 = showdate
xxqcfg_log04 = showtogbx
xxqcfg_chr05 = togbxlab
/*xxqcfg_chr06 = labellist[1]
xxqcfg_chr07 = STRING(formatlist[1])*/
xxqcfg_chr08 = togbxmsgf
xxqcfg_chr09 = togbxmsgt
xxqcfg_chr10 = menuname
xxqcfg_chr11 = viewname
xxqcfg_chr12 = contrname
xxqcfg_chr16 = labellist[1]
xxqcfg_chr17 = STRING(formatlist[1])
xxqcfg_chr18 = STRING(visiblelist[1]).
DO i = 2 TO 7:
ASSIGN
xxqcfg_chr16 = xxqcfg_chr16 + "," + labellist[i]
xxqcfg_chr17 = xxqcfg_chr17 + "," + STRING(formatlist[i])
xxqcfg_chr18 = xxqcfg_chr18 + "," + STRING(visiblelist[i]).
END.
IF AVAILABLE xxqcfg_mstr THEN RELEASE xxqcfg_mstr.
/*COMPILE VALUE(clsname + ".cls") SAVE.*/
MESSAGE "Preview ?" VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE choice.
IF choice THEN
DO:
{gprun.i ""gpwinrun.p"" "(menuname,'Menu Preview(Cimload will rollback)')"}
/*预览模式不会导入数据 因为在loop-b的事务中 ESC就会回滚导入的数据*/
END.
END. /*loop-b*/
END. /*main-loop*/
PROCEDURE dispset.
FIND FIRST xxqcfg_mstr WHERE xxqcfg_type = "GUICIMSET" AND xxqcfg_chr01 = clsname NO-LOCK NO-ERROR.
IF AVAILABLE xxqcfg_mstr THEN
DO:
ASSIGN menuname = xxqcfg_chr10
viewname = xxqcfg_chr11
contrname = xxqcfg_chr12.
IF menuname = '' THEN
ASSIGN menuname = REPLACE(clsname,"cim","xx") + "loadc.p".
DO i = 1 TO 7:
ASSIGN
labellist[i] = ENTRY(i,xxqcfg_chr16)
formatlist[i] = DECIMAL(ENTRY(i,xxqcfg_chr17))
visiblelist[i] = LOGICAL(ENTRY(i,xxqcfg_chr18)).
END.
/*如果为空 则出现默认*/
DISPLAY
menuname
xxqcfg_chr11 @ viewname
xxqcfg_chr12 @ contrname
xxqcfg_chr02 @ frametitle
xxqcfg_chr03 @ bptitle
xxqcfg_chr04 @ datelab
xxqcfg_log02 @ togbx
xxqcfg_log03 @ showdate
xxqcfg_log04 @ showtogbx
xxqcfg_chr05 @ togbxlab
xxqcfg_chr08 @ togbxmsgf
xxqcfg_chr09 @ togbxmsgt
labellist
formatlist
visiblelist
WITH FRAME a.
END.
ELSE DO:
ASSIGN menuname = REPLACE(clsname,"cim","xx") + "loadc.p".
DISPLAY
menuname
contrname
viewname
"" @ frametitle
"" @ bptitle
"" @ datelab
showdate
showtogbx
togbx
"" @ togbxlab
"" @ togbxmsgf
"" @ togbxmsgt
"" @ labellist[1]
"" @ labellist[2]
"" @ labellist[3]
"" @ labellist[4]
"" @ labellist[5]
"" @ labellist[6]
"" @ labellist[7]
"8.00" @ formatlist[1]
"8.00" @ formatlist[2]
"8.00" @ formatlist[3]
"8.00" @ formatlist[4]
"8.00" @ formatlist[5]
"8.00" @ formatlist[6]
"8.00" @ formatlist[7]
"yes" @ visiblelist[1]
"yes" @ visiblelist[2]
"yes" @ visiblelist[3]
"yes" @ visiblelist[4]
"yes" @ visiblelist[5]
"yes" @ visiblelist[6]
"yes" @ visiblelist[7]
WITH FRAME a.
/*{mfmsg.i 1 1}*/
END.
END PROCEDURE.
PROCEDURE compile-rcode:
DEFINE INPUT PARAMETER insname AS CHARACTER NO-UNDO. /*实例名*/
&IF PROVERSION < '11' &THEN
DEFINE VARIABLE tempfile AS CHARACTER NO-UNDO.
DEFINE VARIABLE guipath AS CHARACTER NO-UNDO.
DEFINE VARIABLE j AS INTEGER NO-UNDO.
DO j = 1 TO NUM-ENTRIES(PROPATH): /*程序所在的目录*/
IF ENTRY(j,PROPATH) MATCHES("*\guicli")
THEN DO:
ASSIGN guipath = ENTRY(j,PROPATH).
LEAVE.
END.
END.
ASSIGN tempfile = "d:\xx" + insname + 'loadc.p'.
OUTPUT TO VALUE(tempfile).
PUT UNFORMATTED "~{mfdeclre.i~}" SKIP.
PUT UNFORMATTED "DEFINE VARIABLE " + insname + " AS " + clsname + " NO-UNDO." SKIP.
PUT UNFORMATTED insname + " = NEW " + clsname + "(global_domain,global_user_lang_dir,global_userid)." SKIP.
PUT UNFORMATTED '~{gprun.i ""' + contrname + '"" "(INPUT ' + insname + ')"~}.' SKIP.
PUT UNFORMATTED "DELETE OBJECT " + insname + "." SKIP.
PUT UNFORMATTED insname + "= ?." SKIP.
OUTPUT CLOSE.
COMPILE VALUE(tempfile) SAVE INTO VALUE(guipath + "\" + REPLACE(global_user_lang_dir,"/","\") + "xx").
OS-DELETE VALUE(tempfile) NO-ERROR.
FOR FIRST xxqcfg_mstr WHERE xxqcfg_type = "GUICIMSET" AND xxqcfg_chr01 = clsname:
ASSIGN xxqcfg_chr11 = ''.
END.
IF AVAILABLE xxqcfg_mstr THEN RELEASE xxqcfg_mstr.
MESSAGE "MENU PROGRAM COMPILED,CONTINUE TO SET?" VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE choice.
IF choice THEN
DO:
ASSIGN CLIPBOARD:VALUE = "xx" + insname + 'loadc.p'.
{gprun.i ""gpwinrun.p"" "('mgmemt.p','MENU SYSTEM MAINT')"}
END.
&ENDIF
END PROCEDURE.
2.在Procedure Editor 里运行程序(也可编译后挂菜单)
设置相应字段的名称 宽度 是否显示后 可以预览菜单 (执行cimframe类)
TIPS:在预览模式里测试导入，显示成功也会回滚(事务控制)
3.补充 自动生成的代码(入口程序) compile-rcode子过程生成 这个文件名用来挂菜单
{mfdeclre.i}
DEFINE VARIABLE gcode AS cimgcode NO-UNDO.
gcode = NEW cimgcode(global_domain,global_user_lang_dir,global_userid).
{gprun.i ""xxcimgeneral.p"" "(INPUT gcode)"}.
DELETE OBJECT gcode.
gcode = ?.
分配权限后就可以使用了
浙公网安备 33010602011771号