QAD 实现数据批量导入(GUI版) -Index6-LowCode Model&UIConfig
1.cimlcmodel.cls 作为通用model类，变成可配置
/*------------------------------------------------------------------------
File : cimlcmodel
Purpose :
Syntax :
Description :
Author(s) :
Created : Thu Nov 17 09:13:23 CST 2022
Notes :
----------------------------------------------------------------------*/
&SCOPED-DEFINE SK + CHR(10) +
&SCOPED-DEFINE CFGTYPE 'GUICIMLCSET'
&SCOPED-DEFINE TESTMODE YES
CLASS cimlcmodel INHERITS cimbase IMPLEMENTS Icimode:
/*------------------------------------------------------------------------------
Purpose:
Notes:
------------------------------------------------------------------------------*/
DEFINE BUFFER bfqcfg FOR xxqcfg_mstr.
CONSTRUCTOR PUBLIC cimlcmodel(INPUT domain AS CHARACTER,INPUT langdir AS CHARACTER,INPUT usrid AS CHARACTER,INPUT ecimtype AS CHARACTER):
SUPER(domain,langdir,usrid,?).
FIND FIRST bfqcfg WHERE bfqcfg.xxqcfg_type = {&CFGTYPE} AND bfqcfg.xxqcfg_id = ecimtype NO-LOCK NO-ERROR.
IF AVAILABLE bfqcfg THEN
DO:
ASSIGN
cimtypeid = bfqcfg.xxqcfg_id
dfcimexec = bfqcfg.xxqcfg_chr07.
END.
IF dfcimexec NE SPACES THEN
DO:
tptbhd = preparetbhd().
preparelabel().
END.
END CONSTRUCTOR.
METHOD PROTECTED HANDLE preparetbhd():
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DEFINE VARIABLE lctb AS HANDLE NO-UNDO.
CREATE TEMP-TABLE lctb.
lctb:ADD-NEW-FIELD("tpguid","character").
FOR FIRST bfqcfg WHERE bfqcfg.xxqcfg_type = {&CFGTYPE} AND bfqcfg.xxqcfg_id = cimtypeid NO-LOCK:
DO i = 1 TO NUM-ENTRIES(bfqcfg.xxqcfg_chr15):
IF ENTRY(i,bfqcfg.xxqcfg_chr15) EQ SPACES THEN NEXT.
lctb:ADD-NEW-FIELD(ENTRY(i,bfqcfg.xxqcfg_chr15),ENTRY(i,bfqcfg.xxqcfg_chr19)).
END.
IF bfqcfg.xxqcfg_chr21 NE SPACES THEN
DO i = 1 TO NUM-ENTRIES(bfqcfg.xxqcfg_chr21):
IF ENTRY(i,bfqcfg.xxqcfg_chr21) EQ SPACES THEN NEXT.
lctb:ADD-NEW-FIELD(ENTRY(i,bfqcfg.xxqcfg_chr21),"character"). /*添加要读取结果的字段*/
END.
END.
lctb:ADD-NEW-FIELD("tpisok","logical").
lctb:ADD-NEW-FIELD("tpmsg","character").
lctb:TEMP-TABLE-PREPARE("templcm").
RETURN lctb.
END METHOD.
METHOD PROTECTED VOID preparelabel():
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DEFINE VARIABLE dhbf AS HANDLE NO-UNDO.
dhbf = tptbhd:DEFAULT-BUFFER-HANDLE.
IF VALID-HANDLE(dhbf) THEN
FOR FIRST bfqcfg WHERE bfqcfg.xxqcfg_type = {&CFGTYPE} AND bfqcfg.xxqcfg_id = cimtypeid NO-LOCK:
DO i = 1 TO NUM-ENTRIES(bfqcfg.xxqcfg_chr15):
IF ENTRY(i,bfqcfg.xxqcfg_chr15) EQ SPACES THEN NEXT.
IF ENTRY(i,bfqcfg.xxqcfg_chr16) NE SPACES THEN
dhbf:BUFFER-FIELD(ENTRY(i,bfqcfg.xxqcfg_chr15)):COLUMN-LABEL = ENTRY(i,bfqcfg.xxqcfg_chr16).
END.
IF bfqcfg.xxqcfg_chr21 NE SPACES THEN
DO i = 1 TO NUM-ENTRIES(bfqcfg.xxqcfg_chr21):
IF ENTRY(i,bfqcfg.xxqcfg_chr21) EQ SPACES THEN NEXT.
dhbf:BUFFER-FIELD(ENTRY(i,bfqcfg.xxqcfg_chr21)):COLUMN-LABEL = "NA".
dhbf:BUFFER-FIELD(ENTRY(i,bfqcfg.xxqcfg_chr21)):LABEL = 'STRVAL'.
END. /*标记要读取结果的字段*/
IF LOOKUP("tpcrud",bfqcfg.xxqcfg_chr15) > 0 THEN
dhbf:BUFFER-FIELD("tpcrud"):COLUMN-LABEL = "Operator(blank-add/mod x-delete)".
END.
END METHOD.
METHOD PUBLIC OVERRIDE VOID vexecload(INPUT cimexec AS CHARACTER):
DEFINE VARIABLE dstring AS CHARACTER NO-UNDO. /*字符串流*/
DEFINE VARIABLE dhbf AS HANDLE NO-UNDO.
DEFINE VARIABLE q AS HANDLE NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
dhbf = tptbhd:DEFAULT-BUFFER-HANDLE.
IF VALID-HANDLE(dhbf) THEN
DO:
CREATE QUERY q.
q:SET-BUFFERS(dhbf).
q:QUERY-PREPARE("FOR EACH " + dhbf:TABLE + " WHERE tpmsg = ''").
q:QUERY-OPEN.
REPEAT ON ERROR UNDO,LEAVE:
q:GET-NEXT().
IF q:QUERY-OFF-END THEN LEAVE.
FOR FIRST bfqcfg WHERE bfqcfg.xxqcfg_type = {&CFGTYPE} AND bfqcfg.xxqcfg_id = cimtypeid NO-LOCK:
IF picked THEN
ASSIGN dstring = bfqcfg.xxqcfg_chr14.
ELSE
ASSIGN dstring = bfqcfg.xxqcfg_chr13.
dstring = REPLACE(dstring,"effdate",STRING(effdate)).
IF LOOKUP("tpcrud",bfqcfg.xxqcfg_chr15) > 0 AND INDEX(dstring,'tpcrud') > 0 THEN
DO:
IF dhbf:BUFFER-FIELD("tpcrud"):BUFFER-VALUE EQ 'x' THEN
SUBSTRING(dstring,INDEX(dstring,'tpcrud') + LENGTH('tpcrud'),LENGTH(dstring))
= CHR(10) + '-' {&SK} 'YES'. /*如果是删除 则替换对应字符串*/
END.
DO i = 1 TO NUM-ENTRIES(bfqcfg.xxqcfg_chr15): /*tpchr01 tpchr02 - - - tpdte01*/
IF ENTRY(i,bfqcfg.xxqcfg_chr15) EQ SPACES THEN NEXT.
IF ENTRY(i,bfqcfg.xxqcfg_chr19) EQ "character" THEN
ASSIGN
dstring = REPLACE(dstring,ENTRY(i,bfqcfg.xxqcfg_chr15),QUOTER(dhbf:BUFFER-FIELD(ENTRY(i,bfqcfg.xxqcfg_chr15)):BUFFER-VALUE)).
ELSE
ASSIGN
dstring = REPLACE(dstring,ENTRY(i,bfqcfg.xxqcfg_chr15),setd(STRING(dhbf:BUFFER-FIELD(ENTRY(i,bfqcfg.xxqcfg_chr15)):BUFFER-VALUE))).
END.
dstring = dstring {&SK} ".".
&IF DEFINED(TESTMODE) = 0 &THEN
IF bfqcfg.xxqcfg_chr21 NE SPACES THEN
DO:
cim:invchar = bfqcfg.xxqcfg_chr22.
cim:strexnum = bfqcfg.xxqcfg_int02.
DO i = 1 TO NUM-ENTRIES(bfqcfg.xxqcfg_chr21):
/*MESSAGE global_user_lang_dir + ' ' + ENTRY(i,bfqcfg.xxqcfg_chr21) VIEW-AS ALERT-BOX.*/
cim:setLblname(i,ENTRY(i,bfqcfg.xxqcfg_chr21)).
END.
END.
&ENDIF
cim:uiload(dstring,cimexec).
ASSIGN
dhbf:BUFFER-FIELD("tpisok"):BUFFER-VALUE = NOT cim:hverr /*取反*/
dhbf:BUFFER-FIELD("tpmsg"):BUFFER-VALUE = cim:errmsg.
&IF DEFINED(TESTMODE) = 0 &THEN
IF bfqcfg.xxqcfg_chr21 NE SPACES THEN
DO i = 1 TO NUM-ENTRIES(bfqcfg.xxqcfg_chr21):
ASSIGN
dhbf:BUFFER-FIELD(ENTRY(i,bfqcfg.xxqcfg_chr21)):BUFFER-VALUE = cim:getStrval(i).
END.
&ENDIF
IF cim:hverr THEN UNDO,LEAVE.
END.
END.
q:QUERY-CLOSE().
DELETE OBJECT q.
q = ?.
END.
END METHOD.
METHOD PUBLIC VOID mainblock():
vmainblock(dfcimexec).
END METHOD.
END CLASS.
2.相应的配置界面程序
/*------------------------------------------------------------------------
File : xxguicimlcset.p
Purpose : GUI CIMLOAD LOW-CODE MENU CONFIG
Syntax :
Description :
Author(s) :
Created : Sat Oct 29 13:38:56 CST 2016
Notes :
----------------------------------------------------------------------*/
&SCOPED-DEFINE WIDTHLMT 56
&SCOPED-DEFINE TEMPPATH "D:\"
&SCOPED-DEFINE RCODEPATH "guicli"
&SCOPED-DEFINE TESTMODE YES
/*76 设置最大的合计宽度*/
{mfdtitle.i}
DEFINE VARIABLE xxcimtype AS CHARACTER FORMAT "x(16)" NO-UNDO. /*TYPE-ID*/
DEFINE VARIABLE dfcimexec AS CHARACTER FORMAT "x(16)" NO-UNDO. /*procedure name*/
DEFINE VARIABLE clsname AS CHARACTER FORMAT "x(16)" INIT "cimlcmodel" NO-UNDO. /*类名*/
DEFINE VARIABLE menuname AS CHARACTER FORMAT "x(16)" NO-UNDO.
DEFINE VARIABLE contrname AS CHARACTER FORMAT "x(16)" INIT "xxcimlcgeneral.p" NO-UNDO.
DEFINE VARIABLE viewname AS CHARACTER FORMAT "x(16)" INIT "cimframe.cls" NO-UNDO.
DEFINE VARIABLE frametitle AS CHARACTER FORMAT "x(60)" NO-UNDO.
DEFINE VARIABLE bptitle AS CHARACTER FORMAT "x(60)" NO-UNDO.
DEFINE VARIABLE datelab AS CHARACTER FORMAT "x(12)" NO-UNDO.
DEFINE VARIABLE showdate AS LOGICAL NO-UNDO.
DEFINE VARIABLE retainlog 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(60)" NO-UNDO.
DEFINE VARIABLE togbxmsgt AS CHARACTER FORMAT "x(60)" NO-UNDO.
DEFINE VARIABLE loglevel AS LOGICAL FORMAT "Basic/Verbose" NO-UNDO.
DEFINE VARIABLE cimstr1 AS CHARACTER
VIEW-AS EDITOR SIZE 65 BY 15 SCROLLBAR-VERTICAL NO-UNDO.
DEFINE VARIABLE cimstr2 AS CHARACTER
VIEW-AS EDITOR SIZE 65 BY 15 SCROLLBAR-VERTICAL NO-UNDO.
DEFINE VARIABLE fieldlist AS CHARACTER FORMAT "x(24)" EXTENT 32 NO-UNDO.
DEFINE VARIABLE labellist AS CHARACTER FORMAT "x(24)" EXTENT 32 NO-UNDO.
DEFINE VARIABLE formatlist AS DECIMAL EXTENT 32 NO-UNDO.
DEFINE VARIABLE visiblelist AS LOGICAL EXTENT 7 INIT YES NO-UNDO.
DEFINE VARIABLE dtypelist AS CHARACTER FORMAT "x(24)" EXTENT 32 NO-UNDO.
DEFINE VARIABLE totwidth AS DECIMAL NO-UNDO.
DEFINE VARIABLE otherparams AS CHARACTER FORMAT "x(60)" NO-UNDO.
DEFINE VARIABLE strvalist AS CHARACTER FORMAT "x(60)" NO-UNDO.
DEFINE VARIABLE invchar AS CHARACTER FORMAT "x(2)" INIT ":" NO-UNDO.
DEFINE VARIABLE strexnum AS INTEGER FORMAT ">>" NO-UNDO.
DEFINE VARIABLE i AS INTEGER INITIAL 1 NO-UNDO.
DEFINE VARIABLE choice AS LOGICAL INIT YES NO-UNDO.
DEFINE VARIABLE msgtxt AS CHARACTER NO-UNDO. /*message text*/
FORM /*GUI*/
RECT-FRAME AT ROW 1.4 COLUMN 1.25
RECT-FRAME-LABEL AT ROW 1 COLUMN 3 NO-LABEL
SKIP(.5) /*GUI*/
xxcimtype COLON 20 LABEL "GUI CIMLOAD-ID"
dfcimexec COLON 55 LABEL "EXEC-PRO" SKIP(.1)
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 20 LABEL "DATE LABEL"
showdate COLON 55 LABEL "SHOW DATE" SKIP(.1)
loglevel COLON 20 LABEL "MSG-ERROR LEVEL"
retainlog COLON 55 LABEL "RETAIN LOG" SKIP(.1)
togbxlab COLON 15 LABEL "TOGBX LABEL"
showtogbx COLON 45 LABEL "SHOW TOGBX"
togbx COLON 70 LABEL "TOGBX CHECKED"
SKIP(.1)
togbxmsgf COLON 15 LABEL "UNCHECKED MSG" SKIP(.1)
togbxmsgt COLON 15 LABEL "CHECKED MSG" SKIP(.2)
strvalist COLON 15 LABEL "READ STR-LIST"SKIP(.1)
invchar COLON 20 LABEL "STR EX-SYMB"
strexnum COLON 55 LABEL "STR OFFSET" SKIP(.1)
SKIP(.2)
otherparams COLON 15 LABEL "OTHER PARAMS"
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 LOW-CODE 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*/
FORM
RECT-FRAME AT ROW 1.4 COLUMN 1.25
RECT-FRAME-LABEL AT ROW 1 COLUMN 3 NO-LABEL
SKIP(.2)
fieldlist[1] COLON 12 LABEL "Field[1]"
labellist[1] COLON 50 LABEL "Label[1]" SKIP(.1)
formatlist[1] COLON 12 LABEL "Width[1]"
visiblelist[1] COLON 33 LABEL "Visib[1]"
dtypelist[1] COLON 50 LABEL "Type[1]" SKIP(.2)
fieldlist[2] COLON 12 LABEL "Field[2]"
labellist[2] COLON 50 LABEL "Label[2]" SKIP(.1)
formatlist[2] COLON 12 LABEL "Width[2]"
visiblelist[2] COLON 33 LABEL "Visib[2]"
dtypelist[2] COLON 50 LABEL "Type[2]" SKIP(.2)
fieldlist[3] COLON 12 LABEL "Field[3]"
labellist[3] COLON 50 LABEL "Label[3]" SKIP(.1)
formatlist[3] COLON 12 LABEL "Width[3]"
visiblelist[3] COLON 33 LABEL "Visib[3]"
dtypelist[3] COLON 50 LABEL "Type[3]"SKIP(.2)
fieldlist[4] COLON 12 LABEL "Field[4]"
labellist[4] COLON 50 LABEL "Label[4]" SKIP(.1)
formatlist[4] COLON 12 LABEL "Width[4]"
visiblelist[4] COLON 33 LABEL "Visib[4]"
dtypelist[4] COLON 50 LABEL "Type[4]" SKIP(.2)
fieldlist[5] COLON 12 LABEL "Field[5]"
labellist[5] COLON 50 LABEL "Label[5]" SKIP(.1)
formatlist[5] COLON 12 LABEL "Width[5]"
visiblelist[5] COLON 33 LABEL "Visib[5]"
dtypelist[5] COLON 50 LABEL "Type[5]" SKIP(.2)
fieldlist[6] COLON 12 LABEL "Field[6]"
labellist[6] COLON 50 LABEL "Label[6]" SKIP(.1)
formatlist[6] COLON 12 LABEL "Width[6]"
visiblelist[6] COLON 33 LABEL "Visib[6]"
dtypelist[6] COLON 50 LABEL "Type[6]"SKIP(.2)
fieldlist[7] COLON 12 LABEL "Field[7]"
labellist[7] COLON 50 LABEL "Label[7]" SKIP(.1)
formatlist[7] COLON 12 LABEL "Width[7]"
visiblelist[7] COLON 33 LABEL "Visib[7]"
dtypelist[7] COLON 50 LABEL "Type[7]"SKIP(.2)
fieldlist[8] COLON 12 LABEL "Field[8]"
labellist[8] COLON 50 LABEL "Label[8]" SKIP(.1)
formatlist[8] COLON 12 LABEL "Width[8]"
dtypelist[8] COLON 50 LABEL "Type[8]" SKIP(.2)
SKIP(.2)
WITH FRAME c SIDE-LABELS WIDTH 80 ATTR-SPACE
NO-BOX THREE-D /*GUI*/.
RECT-FRAME-LABEL:SCREEN-VALUE IN FRAME c = "Temp-Table Field Config 1".
RECT-FRAME-LABEL:WIDTH-PIXELS IN FRAME c = FONT-TABLE:GET-TEXT-WIDTH-PIXELS(RECT-FRAME-LABEL:SCREEN-VALUE IN FRAME c + " ",RECT-FRAME-LABEL:FONT).
RECT-FRAME:HEIGHT-PIXELS IN FRAME c = FRAME c:HEIGHT-PIXELS - RECT-FRAME:Y IN FRAME c - 2.
RECT-FRAME:WIDTH-CHARS IN FRAME c = FRAME c:WIDTH-CHARS - .5. /*GUI*/
FORM
RECT-FRAME AT ROW 1.4 COLUMN 1.25
RECT-FRAME-LABEL AT ROW 1 COLUMN 3 NO-LABEL
SKIP(.2)
fieldlist[9] COLON 12 LABEL "Field[9]"
labellist[9] COLON 50 LABEL "Label[9]" SKIP(.1)
formatlist[9] COLON 12 LABEL "Width[9]"
dtypelist[9] COLON 50 LABEL "Type[9]" SKIP(.2)
fieldlist[10] COLON 12 LABEL "Field[10]"
labellist[10] COLON 50 LABEL "Label[10]" SKIP(.1)
formatlist[10] COLON 12 LABEL "Width[10]"
dtypelist[10] COLON 50 LABEL "Type[10]"SKIP(.2)
fieldlist[11] COLON 12 LABEL "Field[11]"
labellist[11] COLON 50 LABEL "Label[11]" SKIP(.1)
formatlist[11] COLON 12 LABEL "Width[11]"
dtypelist[11] COLON 50 LABEL "Type[11]" SKIP(.2)
fieldlist[12] COLON 12 LABEL "Field[12]"
labellist[12] COLON 50 LABEL "Label[12]" SKIP(.1)
formatlist[12] COLON 12 LABEL "Width[12]"
dtypelist[12] COLON 50 LABEL "Type[12]" SKIP(.2)
fieldlist[13] COLON 12 LABEL "Field[13]"
labellist[13] COLON 50 LABEL "Label[13]" SKIP(.1)
formatlist[13] COLON 12 LABEL "Width[13]"
dtypelist[13] COLON 50 LABEL "Type[13]"SKIP(.2)
fieldlist[14] COLON 12 LABEL "Field[14]"
labellist[14] COLON 50 LABEL "Label[14]" SKIP(.1)
formatlist[14] COLON 12 LABEL "Width[14]"
dtypelist[14] COLON 50 LABEL "Type[14]"SKIP(.2)
fieldlist[15] COLON 12 LABEL "Field[15]"
labellist[15] COLON 50 LABEL "Label[15]" SKIP(.1)
formatlist[15] COLON 12 LABEL "Width[15]"
dtypelist[15] COLON 50 LABEL "Type[15]"SKIP(.2)
fieldlist[16] COLON 12 LABEL "Field[16]"
labellist[16] COLON 50 LABEL "Label[16]" SKIP(.1)
formatlist[16] COLON 12 LABEL "Width[16]"
dtypelist[16] COLON 50 LABEL "Type[16]" SKIP(.2)
SKIP(.2)
WITH FRAME d SIDE-LABELS WIDTH 80 ATTR-SPACE
NO-BOX THREE-D /*GUI*/.
RECT-FRAME-LABEL:SCREEN-VALUE IN FRAME d = "Temp-Table Field Config 2".
RECT-FRAME-LABEL:WIDTH-PIXELS IN FRAME d = FONT-TABLE:GET-TEXT-WIDTH-PIXELS(RECT-FRAME-LABEL:SCREEN-VALUE IN FRAME d + " ",RECT-FRAME-LABEL:FONT).
RECT-FRAME:HEIGHT-PIXELS IN FRAME d = FRAME d:HEIGHT-PIXELS - RECT-FRAME:Y IN FRAME d - 2.
RECT-FRAME:WIDTH-CHARS IN FRAME d = FRAME d:WIDTH-CHARS - .5. /*GUI*/
FORM
RECT-FRAME AT ROW 1.4 COLUMN 1.25
RECT-FRAME-LABEL AT ROW 1 COLUMN 3 NO-LABEL
SKIP(.2)
fieldlist[17] COLON 12 LABEL "Field[17]"
labellist[17] COLON 50 LABEL "Label[17]" SKIP(.1)
formatlist[17] COLON 12 LABEL "Width[17]"
dtypelist[17] COLON 50 LABEL "Type[17]" SKIP(.2)
fieldlist[18] COLON 12 LABEL "Field[18]"
labellist[18] COLON 50 LABEL "Label[18]" SKIP(.1)
formatlist[18] COLON 12 LABEL "Width[18]"
dtypelist[18] COLON 50 LABEL "Type[18]"SKIP(.2)
fieldlist[19] COLON 12 LABEL "Field[19]"
labellist[19] COLON 50 LABEL "Label[19]" SKIP(.1)
formatlist[19] COLON 12 LABEL "Width[19]"
dtypelist[19] COLON 50 LABEL "Type[19]" SKIP(.2)
fieldlist[20] COLON 12 LABEL "Field[20]"
labellist[20] COLON 50 LABEL "Label[20]" SKIP(.1)
formatlist[20] COLON 12 LABEL "Width[20]"
dtypelist[20] COLON 50 LABEL "Type[20]" SKIP(.2)
fieldlist[21] COLON 12 LABEL "Field[21]"
labellist[21] COLON 50 LABEL "Label[21]" SKIP(.1)
formatlist[21] COLON 12 LABEL "Width[21]"
dtypelist[21] COLON 50 LABEL "Type[21]"SKIP(.2)
fieldlist[22] COLON 12 LABEL "Field[22]"
labellist[22] COLON 50 LABEL "Label[22]" SKIP(.1)
formatlist[22] COLON 12 LABEL "Width[22]"
dtypelist[22] COLON 50 LABEL "Type[22]"SKIP(.2)
fieldlist[23] COLON 12 LABEL "Field[23]"
labellist[23] COLON 50 LABEL "Label[23]" SKIP(.1)
formatlist[23] COLON 12 LABEL "Width[23]"
dtypelist[23] COLON 50 LABEL "Type[23]"SKIP(.2)
fieldlist[24] COLON 12 LABEL "Field[24]"
labellist[24] COLON 50 LABEL "Label[24]" SKIP(.1)
formatlist[24] COLON 12 LABEL "Width[24]"
dtypelist[24] COLON 50 LABEL "Type[24]" SKIP(.2)
SKIP(.2)
WITH FRAME e SIDE-LABELS WIDTH 80 ATTR-SPACE
NO-BOX THREE-D /*GUI*/.
RECT-FRAME-LABEL:SCREEN-VALUE IN FRAME e = "Temp-Table Field Config 3".
RECT-FRAME-LABEL:WIDTH-PIXELS IN FRAME e = FONT-TABLE:GET-TEXT-WIDTH-PIXELS(RECT-FRAME-LABEL:SCREEN-VALUE IN FRAME e + " ",RECT-FRAME-LABEL:FONT).
RECT-FRAME:HEIGHT-PIXELS IN FRAME e = FRAME e:HEIGHT-PIXELS - RECT-FRAME:Y IN FRAME e - 2.
RECT-FRAME:WIDTH-CHARS IN FRAME e = FRAME e:WIDTH-CHARS - .5. /*GUI*/
FORM
RECT-FRAME AT ROW 1.4 COLUMN 1.25
RECT-FRAME-LABEL AT ROW 1 COLUMN 3 NO-LABEL
SKIP(.2)
fieldlist[25] COLON 12 LABEL "Field[25]"
labellist[25] COLON 50 LABEL "Label[25]" SKIP(.1)
formatlist[25] COLON 12 LABEL "Width[25]"
dtypelist[25] COLON 50 LABEL "Type[25]" SKIP(.2)
fieldlist[26] COLON 12 LABEL "Field[26]"
labellist[26] COLON 50 LABEL "Label[26]" SKIP(.1)
formatlist[26] COLON 12 LABEL "Width[26]"
dtypelist[26] COLON 50 LABEL "Type[26]"SKIP(.2)
fieldlist[27] COLON 12 LABEL "Field[27]"
labellist[27] COLON 50 LABEL "Label[27]" SKIP(.1)
formatlist[27] COLON 12 LABEL "Width[27]"
dtypelist[27] COLON 50 LABEL "Type[27]" SKIP(.2)
fieldlist[28] COLON 12 LABEL "Field[28]"
labellist[28] COLON 50 LABEL "Label[28]" SKIP(.1)
formatlist[28] COLON 12 LABEL "Width[28]"
dtypelist[28] COLON 50 LABEL "Type[28]" SKIP(.2)
fieldlist[29] COLON 12 LABEL "Field[29]"
labellist[29] COLON 50 LABEL "Label[29]" SKIP(.1)
formatlist[29] COLON 12 LABEL "Width[29]"
dtypelist[29] COLON 50 LABEL "Type[29]"SKIP(.2)
fieldlist[30] COLON 12 LABEL "Field[30]"
labellist[30] COLON 50 LABEL "Label[30]" SKIP(.1)
formatlist[30] COLON 12 LABEL "Width[30]"
dtypelist[30] COLON 50 LABEL "Type[30]"SKIP(.2)
fieldlist[31] COLON 12 LABEL "Field[31]"
labellist[31] COLON 50 LABEL "Label[31]" SKIP(.1)
formatlist[31] COLON 12 LABEL "Width[31]"
dtypelist[31] COLON 50 LABEL "Type[31]"SKIP(.2)
fieldlist[32] COLON 12 LABEL "Field[32]"
labellist[32] COLON 50 LABEL "Label[32]" SKIP(.1)
formatlist[32] COLON 12 LABEL "Width[32]"
dtypelist[32] COLON 50 LABEL "Type[32]"SKIP(.2)
SKIP(.2)
WITH FRAME f SIDE-LABELS WIDTH 80 ATTR-SPACE
NO-BOX THREE-D /*GUI*/.
RECT-FRAME-LABEL:SCREEN-VALUE IN FRAME f = "Temp-Table Field Config 4".
RECT-FRAME-LABEL:WIDTH-PIXELS IN FRAME f = FONT-TABLE:GET-TEXT-WIDTH-PIXELS(RECT-FRAME-LABEL:SCREEN-VALUE IN FRAME f + " ",RECT-FRAME-LABEL:FONT).
RECT-FRAME:HEIGHT-PIXELS IN FRAME f = FRAME f:HEIGHT-PIXELS - RECT-FRAME:Y IN FRAME f - 2.
RECT-FRAME:WIDTH-CHARS IN FRAME f = FRAME f:WIDTH-CHARS - .5. /*GUI*/
FORM
RECT-FRAME AT ROW 1.4 COLUMN 1.25
RECT-FRAME-LABEL AT ROW 1 COLUMN 3 NO-LABEL
SKIP(.2) /*GUI*/
cimstr1 COLON 12 LABEL "CIM-STRING"
SKIP(1)
WITH FRAME z SIDE-LABELS WIDTH 80 ATTR-SPACE
NO-BOX THREE-D /*GUI*/.
RECT-FRAME-LABEL:SCREEN-VALUE IN FRAME z = "CIMLOAD Stream String".
RECT-FRAME-LABEL:WIDTH-PIXELS IN FRAME z = FONT-TABLE:GET-TEXT-WIDTH-PIXELS(RECT-FRAME-LABEL:SCREEN-VALUE IN FRAME z + " ",RECT-FRAME-LABEL:FONT).
RECT-FRAME:HEIGHT-PIXELS IN FRAME z = FRAME z:HEIGHT-PIXELS - RECT-FRAME:Y IN FRAME z - 2.
RECT-FRAME:WIDTH-CHARS IN FRAME z = FRAME z:WIDTH-CHARS - .5. /*GUI*/
FORM
RECT-FRAME AT ROW 1.4 COLUMN 1.25
RECT-FRAME-LABEL AT ROW 1 COLUMN 3 NO-LABEL
SKIP(.2) /*GUI*/
cimstr2 COLON 12 LABEL "CIM-STRING"
SKIP(1)
WITH FRAME P SIDE-LABELS WIDTH 80 ATTR-SPACE
NO-BOX THREE-D /*GUI*/.
RECT-FRAME-LABEL:SCREEN-VALUE IN FRAME P = "CIMLOAD Stream String(TOGBX CHECKED)".
RECT-FRAME-LABEL:WIDTH-PIXELS IN FRAME P = FONT-TABLE:GET-TEXT-WIDTH-PIXELS(RECT-FRAME-LABEL:SCREEN-VALUE IN FRAME P + " ",RECT-FRAME-LABEL:FONT).
RECT-FRAME:HEIGHT-PIXELS IN FRAME P = FRAME P:HEIGHT-PIXELS - RECT-FRAME:Y IN FRAME P - 2.
RECT-FRAME:WIDTH-CHARS IN FRAME P = FRAME P:WIDTH-CHARS - .5. /*GUI*/
mainloop:
REPEAT WITH FRAME a ON ENDKEY UNDO mainloop,LEAVE mainloop:
UPDATE
xxcimtype VALIDATE(xxcimtype NE "","CIM-TYPE cannot be blank!")
HELP "Please enter the CIM-TYPE ID"
WITH FRAME a
EDITING:
/* FIND NEXT/PREVIOUS RECORD */
&IF DEFINED(TESTMODE) > 0 &THEN
{us/mf/mfnp.i xxqcfg_mstr xxcimtype "xxqcfg_type = 'GUICIMLCSET' AND xxqcfg_id" xxcimtype xxqcfg_id xxqcfg_type}
&ELSE
{mfnp.i xxqcfg_mstr xxcimtype "xxqcfg_type = 'GUICIMLCSET' AND xxqcfg_id" xxcimtype xxqcfg_id xxqcfg_type}
&ENDIF
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_id @ xxcimtype
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_log05 @ retainlog
xxqcfg_log06 @ loglevel
xxqcfg_chr05 @ togbxlab
xxqcfg_chr07 @ dfcimexec
xxqcfg_chr08 @ togbxmsgf
xxqcfg_chr09 @ togbxmsgt
xxqcfg_chr21 @ strvalist
xxqcfg_chr22 @ invchar
xxqcfg_int02 @ strexnum
xxqcfg_chr20 @ otherparams
WITH FRAME a.
recno = ?.
END.
END. /* EDITING */
IF NOT xxcimtype BEGINS 'xx' THEN
DO:
msgtxt = "CIM-TYPE should begin with 'xx' prefix".
&IF DEFINED(TESTMODE) > 0 &THEN
{us/bbi/pxmsg.i &MSGTEXT=msgtxt &ERRORLEVEL=4}
&ELSE
{pxmsg.i &MSGTEXT=msgtxt &ERRORLEVEL=4}
&ENDIF
UNDO,RETRY.
END.
IF SEARCH(clsname + ".cls") = ? AND SEARCH(clsname + ".r") = ? THEN
DO:
msgtxt = "MODEL-PROGRAM " + clsname + ".cls" + " does not exist".
&IF DEFINED(TESTMODE) > 0 &THEN
{us/bbi/pxmsg.i &MSGTEXT=msgtxt &ERRORLEVEL=4}
&ELSE
{pxmsg.i &MSGTEXT=msgtxt &ERRORLEVEL=4}
&ENDIF
UNDO,RETRY.
END.
RUN dispset.
SET
dfcimexec
contrname HELP "F6=Re-compile Menu Program F7=Preview the Menu Program"
/*viewname*/ GO-ON ("F6" "F7")
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(xxcimtype).
END.
IF LASTKEY = KEYCODE("F7") /*预览*/
THEN
DO:
MESSAGE "Preview ?" VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE choice.
IF choice THEN
DO:
&IF DEFINED(TESTMODE) > 0 &THEN
{us/bbi/gprun.i ""gpwinrun.p"" "(menuname,'Menu Preview')"}
&ELSE
{gprun.i ""gpwinrun.p"" "(menuname,'Menu Preview')"}
&ENDIF
END.
END.
IF dfcimexec EQ ''
THEN DO:
msgtxt = "EXEC-PROGRAM can't be blank".
&IF DEFINED(TESTMODE) > 0 &THEN
{us/bbi/pxmsg.i &MSGTEXT=msgtxt &ERRORLEVEL=4}
&ELSE
{pxmsg.i &MSGTEXT=msgtxt &ERRORLEVEL=4}
&ENDIF
UNDO,RETRY.
END.
FIND FIRST mnd_det WHERE mnd_exec = dfcimexec NO-LOCK NO-ERROR.
IF NOT AVAILABLE mnd_det
THEN DO:
msgtxt = "EXEC-PROGRAM does not exist in menu system".
&IF DEFINED(TESTMODE) > 0 &THEN
{us/bbi/pxmsg.i &MSGTEXT=msgtxt &ERRORLEVEL=4}
&ELSE
{pxmsg.i &MSGTEXT=msgtxt &ERRORLEVEL=4}
&ENDIF
UNDO,RETRY.
END.
ELSE IF frametitle EQ '' THEN
frametitle = mnd_label.
IF contrname EQ ''
THEN DO:
msgtxt = "CONTROLLER-PROGRAM can't be blank".
&IF DEFINED(TESTMODE) > 0 &THEN
{us/bbi/pxmsg.i &MSGTEXT=msgtxt &ERRORLEVEL=4}
&ELSE
{pxmsg.i &MSGTEXT=msgtxt &ERRORLEVEL=4}
&ENDIF
NEXT-PROMPT contrname WITH FRAME a.
UNDO,RETRY.
END.
loop-b:
REPEAT ON ENDKEY UNDO loop-b,LEAVE loop-b:
SET
frametitle
bptitle
datelab
showdate
loglevel
retainlog
togbxlab
showtogbx
togbx
togbxmsgf
togbxmsgt
strvalist
invchar
strexnum
otherparams
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 = "GUICIMLCSET" AND xxqcfg_id = xxcimtype 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 = "GUICIMLCSET" AND xxqcfg_id = xxcimtype NO-ERROR.
IF NOT AVAILABLE xxqcfg_mstr THEN DO:
CREATE xxqcfg_mstr.
ASSIGN xxqcfg_type = "GUICIMLCSET"
xxqcfg_id = xxcimtype
xxqcfg_userid = global_userid
xxqcfg_create = NOW.
END.
ASSIGN
xxqcfg_chr01 = clsname
xxqcfg_chr02 = frametitle
xxqcfg_chr03 = bptitle
xxqcfg_chr04 = datelab
xxqcfg_log02 = togbx
xxqcfg_log03 = showdate
xxqcfg_log04 = showtogbx
xxqcfg_log05 = retainlog
xxqcfg_log06 = loglevel
xxqcfg_chr05 = togbxlab
/*xxqcfg_chr06 = labellist[1]*/
xxqcfg_chr07 = dfcimexec
xxqcfg_chr08 = togbxmsgf
xxqcfg_chr09 = togbxmsgt
xxqcfg_chr10 = menuname
xxqcfg_chr11 = viewname
xxqcfg_chr12 = contrname
xxqcfg_chr21 = strvalist
xxqcfg_chr22 = invchar
xxqcfg_int02 = strexnum
/*New-added*/
xxqcfg_chr20 = otherparams.
IF AVAILABLE xxqcfg_mstr OR NEW xxqcfg_mstr THEN
DO:
DO i = 1 TO EXTENT(fieldlist):
ASSIGN
fieldlist[i] = ""
dtypelist[i] = ""
formatlist[i] = 0
labellist[i] = "".
END.
DO i = 1 TO 7:
visiblelist[i] = LOGICAL(ENTRY(i,xxqcfg_chr18)) NO-ERROR.
IF ERROR-STATUS:ERROR OR visiblelist[i] = ? THEN visiblelist[i] = YES.
END.
DO i = 1 TO NUM-ENTRIES(xxqcfg_chr15):
ASSIGN
fieldlist[i] = ENTRY(i,xxqcfg_chr15)
labellist[i] = ENTRY(i,xxqcfg_chr16)
dtypelist[i] = ENTRY(i,xxqcfg_chr19)
formatlist[i] = DECIMAL(ENTRY(i,xxqcfg_chr17)) NO-ERROR.
END.
ASSIGN
cimstr1 = xxqcfg_chr13
cimstr2 = xxqcfg_chr14.
END.
IF AVAILABLE xxqcfg_mstr THEN RELEASE xxqcfg_mstr.
MESSAGE "SETTINGS SAVED".
UPDATE
fieldlist [1 FOR 8]
labellist [1 FOR 8]
formatlist [1 FOR 8]
visiblelist [1 FOR 7]
dtypelist [1 FOR 8]
WITH FRAME c.
UPDATE fieldlist [9 FOR 8]
labellist [9 FOR 8]
formatlist [9 FOR 8]
dtypelist [9 FOR 8]
WITH FRAME d.
UPDATE fieldlist [17 FOR 8]
labellist [17 FOR 8]
formatlist [17 FOR 8]
dtypelist [17 FOR 8]
WITH FRAME e.
UPDATE fieldlist [25 FOR 8]
labellist [25 FOR 8]
formatlist [25 FOR 8]
dtypelist [25 FOR 8]
WITH FRAME f.
DO i = 1 TO EXTENT(fieldlist):
IF fieldlist[i] EQ '' THEN LEAVE.
IF dtypelist[i] EQ '' THEN dtypelist[i] = 'character'. /*默认*/
IF dtypelist[i] NE '' THEN
DO:
IF LOOKUP(dtypelist[i],'character,date,integer,datetime,logical,decimal') = 0
THEN DO:
msgtxt = "Data Type: " + dtypelist[i] + ' is invalid'.
&IF DEFINED(TESTMODE) > 0 &THEN
{us/bbi/pxmsg.i &MSGTEXT=msgtxt &ERRORLEVEL=4}
&ELSE
{pxmsg.i &MSGTEXT=msgtxt &ERRORLEVEL=4}
&ENDIF
END.
END.
END.
UPDATE
cimstr1 HELP "Var: effdate is used for the DATE LABEL when it's available"
WITH FRAME z.
IF showtogbx THEN
UPDATE
cimstr2 HELP "Var: effdate is used for the DATE LABEL when it's available"
WITH FRAME p.
FIND FIRST xxqcfg_mstr WHERE xxqcfg_type = "GUICIMLCSET" AND xxqcfg_id = xxcimtype NO-ERROR.
IF AVAILABLE xxqcfg_mstr THEN
DO:
ASSIGN
xxqcfg_chr15 = fieldlist[1]
xxqcfg_chr16 = labellist[1]
xxqcfg_chr17 = STRING(formatlist[1])
xxqcfg_chr18 = STRING(visiblelist[1])
xxqcfg_chr19 = dtypelist[1].
DO i = 2 TO 7:
xxqcfg_chr18 = xxqcfg_chr18 + "," + STRING(visiblelist[i]).
END.
DO i = 2 TO EXTENT(fieldlist):
IF fieldlist[i] EQ '' AND i > 7 THEN LEAVE.
ASSIGN
xxqcfg_chr15 = xxqcfg_chr15 + "," + fieldlist[i]
xxqcfg_chr16 = xxqcfg_chr16 + "," + labellist[i]
xxqcfg_chr17 = xxqcfg_chr17 + "," + STRING(formatlist[i])
xxqcfg_chr19 = xxqcfg_chr19 + "," + dtypelist[i].
END.
ASSIGN
xxqcfg_chr13 = cimstr1
xxqcfg_chr14 = cimstr2.
MESSAGE "FIELD SETTINGS SAVED".
END.
IF AVAILABLE xxqcfg_mstr THEN RELEASE xxqcfg_mstr.
END. /*loop-b*/
END. /*main-loop*/
/*
PROCEDURE checkcimstr: /*不用检查 因为是可以输入常量的*/
DEFINE INPUT PARAMETER ecimstr AS CHARACTER NO-UNDO.
DEFINE VARIABLE m AS INTEGER NO-UNDO.
DEFINE VARIABLE linestr AS CHARACTER NO-UNDO.
DEFINE VARIABLE n AS INTEGER NO-UNDO.
IF ecimstr NE '' THEN
DO m = 1 TO NUM-ENTRIES(ecimstr,CHR(10)):
linestr = ENTRY(m,ecimstr,CHR(10)).
IF linestr NE '' THEN
DO n = 1 TO NUM-ENTRIES(linestr,' '):
IF ENTRY(n,linestr,' ') EQ '-' THEN NEXT.
END.
END.
END PROCEDURE.
*/
PROCEDURE dispset.
FIND FIRST xxqcfg_mstr WHERE xxqcfg_type = "GUICIMLCSET" AND xxqcfg_id = xxcimtype NO-LOCK NO-ERROR.
IF AVAILABLE xxqcfg_mstr THEN
DO:
ASSIGN
clsname = xxqcfg_chr01
menuname = xxqcfg_chr10
viewname = xxqcfg_chr11
contrname = xxqcfg_chr12.
IF menuname = '' THEN
ASSIGN menuname = xxcimtype + "ldc.p".
/*如果为空 则出现默认*/
DISPLAY
clsname
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_log05 @ retainlog
xxqcfg_log06 @ loglevel
xxqcfg_chr05 @ togbxlab
xxqcfg_chr07 @ dfcimexec
xxqcfg_chr08 @ togbxmsgf
xxqcfg_chr09 @ togbxmsgt
xxqcfg_chr21 @ strvalist
xxqcfg_chr22 @ invchar
xxqcfg_int02 @ strexnum
xxqcfg_chr20 @ otherparams
WITH FRAME a.
END.
ELSE DO:
ASSIGN menuname = xxcimtype + "ldc.p".
DISPLAY
dfcimexec
clsname
menuname
contrname
viewname
"" @ frametitle
"" @ bptitle
"" @ datelab
showdate
retainlog
showtogbx
togbx
"" @ togbxlab
"" @ togbxmsgf
"" @ togbxmsgt
"" @ strvalist
"" @ invchar
0 @ strexnum
"" @ otherparams
WITH FRAME a.
/*{mfmsg.i 1 1}*/
END.
END PROCEDURE.
PROCEDURE compile-rcode:
DEFINE INPUT PARAMETER insname AS CHARACTER NO-UNDO. /*实例名*/
&IF DEFINED(TESTMODE) = 0 &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("*\" + {&RCODEPATH})
THEN DO:
ASSIGN guipath = ENTRY(j,PROPATH).
LEAVE.
END.
END.
ASSIGN tempfile = {&TEMPPATH} + insname + 'ldc.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," + QUOTER(insname) + ")." SKIP.
PUT UNFORMATTED '~{gprun.i ""' + contrname + '"" "(INPUT "' + QUOTER(insname) + '",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 = "GUICIMLCSET" AND xxqcfg_id = xxcimtype:
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 = insname + 'ldc.p'.
{gprun.i ""gpwinrun.p"" "('mgmemt.p','MENU SYSTEM MAINT')"}
END.
&ENDIF
END PROCEDURE.
3.在Procedure Editor 里运行程序(或编译后挂菜单)
GUI CIMLOAD-ID: 自定义ID名 EXEC-PRO:原始程序名 例子里是ardrmt.p
MODEL/MENU-PROGRAM 默认 CONTR-PROGRAM: xxcimlcgeneral.p
其余各项参数按需求设置
此界面设置读取数据临时表的字段名称 标签 类型等，供生成模板和读取数据使用
依据Cimload的格式需求，把之前定义的字段填入组成字符串流
通过预览按钮可以进行导入界面的预览和测试，完成后可以就设置菜单并使用
TIPS:在预览模式里测试导入，显示成功也会回滚(事务控制)
4.其余程序代码
/*------------------------------------------------------------------------
File : xxcimlcgeneral.p
Purpose : FOR CIMLOAD COMMON USE
Syntax :
Description :
Author(s) :
Created : Sat Oct 29 12:54:11 CST 2016
Notes :
----------------------------------------------------------------------*/
{mfdtitle.i}
DEFINE INPUT PARAMETER xxcimtype AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER l AS Icimode NO-UNDO.
DEFINE VARIABLE c AS cimframe NO-UNDO.
/* *************************** Main Block *************************** */
c = NEW cimframe(INPUT l).
FOR FIRST xxqcfg_mstr WHERE xxqcfg_type = "GUICIMLCSET" AND xxqcfg_id = xxcimtype AND xxqcfg_chr11 EQ '':
ASSIGN xxqcfg_chr11 = ENTRY(1,c:tostring(),"_") + '.cls'.
END.
IF AVAILABLE xxqcfg_mstr THEN RELEASE xxqcfg_mstr.
FIND FIRST xxqcfg_mstr WHERE xxqcfg_type = "GUICIMLCSET" AND xxqcfg_id = xxcimtype NO-LOCK NO-ERROR.
IF AVAILABLE xxqcfg_mstr THEN DO:
ASSIGN
c:frametitle = xxqcfg_chr02
c:bptitle = xxqcfg_chr03
c:datelab = xxqcfg_chr04
c:togbx = xxqcfg_log02
c:showdate = xxqcfg_log03
c:showtogbx = xxqcfg_log04
c:togbxlab = xxqcfg_chr05
c:togbxmsgf = xxqcfg_chr08
c:togbxmsgt = xxqcfg_chr09
c:labellist = xxqcfg_chr16
c:formatlist = xxqcfg_chr17
c:visiblelist = xxqcfg_chr18.
l:setlogmode(xxqcfg_log05).
l:setloglevel(xxqcfg_log06).
/*更新类名*/
END.
ELSE MESSAGE "This Cimload Menu was not set up" VIEW-AS ALERT-BOX WARNING.
batchrun = YES.
c:waitset(). /*程序驻留 wait to windows close*/
batchrun = NO.
DELETE OBJECT c.
c = ?.
浙公网安备 33010602011771号