Files
MBS/PROYECTO/otrodir/dbadministrator/fgldialog.4gl
T

386 lines
11 KiB
Plaintext

#+ Helper functions.
#+
DEFINE fgl_winDialogDirection STRING
#+ Is this 4gl program connected to a graphical user interface?
#+ @returnType Integer
#+ @return TRUE if connected to graphical user interface.
FUNCTION fgl_fglGui()
DEFINE uiName String
WHENEVER ERROR RAISE
LET uiName=ui.Interface.getFrontEndName()
IF uiName IS NOT NULL then
IF NOT uiName.equals("Console") THEN
RETURN 1
END IF
END IF
WHENEVER ERROR STOP
RETURN 0
END FUNCTION
#+ Opens window with message and choice.
#+ @returnType String
#+ @return The answer string.
#+ @param title Title of the window.
#+ @param message Message to be displayed.
#+ @param ans Default answer.
#+ @param items Pipe separated list of choices.
#+ @param icon Icon specification: 'info','exclamation','stop','question'.
#+ @param dang Danger indicator level ( 0, 1, 2, 3 ) - ignored.
#+
#+ The function returns one of the case-sensitive Strings in the items list.
#+ Displays a message with definable multiple choices.
FUNCTION fgl_winButton(title,message,ans,items,icon,dang)
DEFINE title, message, ans, items, icon STRING
DEFINE dang INTEGER -- unused ?
DEFINE i, itemC INTEGER
DEFINE result String
DEFINE tokenizer base.StringTokenizer
DEFINE itemV array[10] of STRING
DEFINE styleToUse STRING
DEFINE ansU STRING
IF title IS NULL THEN LET title = "" END IF
IF message IS NULL THEN LET message = "" END IF
IF icon IS NULL THEN LET icon = "" END IF
LET title=title.trimRight()
LET message=message.trimRight()
LET icon=icon.trimRight()
LET tokenizer=base.StringTokenizer.create(items,"|")
LET itemC=0
WHILE tokenizer.hasMoreTokens() AND itemC<10
LET itemC=itemC+1
LET itemV[itemC]=tokenizer.nextToken()
END WHILE
IF itemC = 0 THEN RETURN NULL END IF
IF NOT fgl_fglGui() THEN RETURN NULL END IF
IF icon="info" THEN
LET icon="information"
END IF
IF icon != "information" AND icon != "exclamation" AND icon != "stop"
AND icon != "question"
THEN
LET icon = NULL
END IF
LET result = ans
FOR i = itemC+1 TO 10
LET itemV[i]="fgl_winButton_item_No_"||i
END FOR
LET ansU=ans.toUpperCase()
LET styleToUse = "dialog" , fgl_winDialogDirection
MENU title ATTRIBUTE(STYLE=styleToUse,COMMENT=message,IMAGE=icon)
BEFORE MENU
FOR i = itemC+1 TO 10
HIDE OPTION itemV[i]
END FOR
FOR i=1 TO itemC
IF upshift(itemV[i])=ansU THEN
NEXT OPTION itemV[i]
EXIT FOR
END IF
END FOR
COMMAND itemV[1]
LET result=itemV[1]
COMMAND itemV[2]
LET result=itemV[2]
COMMAND itemV[3]
LET result=itemV[3]
COMMAND itemV[4]
LET result=itemV[4]
COMMAND itemV[5]
LET result=itemV[5]
COMMAND itemV[6]
LET result=itemV[6]
COMMAND itemV[7]
LET result=itemV[7]
COMMAND itemV[8]
LET result=itemV[8]
COMMAND itemV[9]
LET result=itemV[9]
COMMAND itemV[10]
LET result=itemV[10]
END MENU
RETURN result
END FUNCTION
#+ Shows a window with message and OK button.
#+ @param title Title of the window.
#+ @param message Message to be displayed.
#+ @param icon Icon specification: 'info','exclamation','stop','question'.
FUNCTION fgl_winMessage(title,message,icon)
DEFINE title String
DEFINE message String
DEFINE icon String
DEFINE ans CHAR(1)
IF NOT fgl_fglGui() THEN
IF LENGTH(message) THEN
PROMPT message CLIPPED FOR CHAR ans
ELSE
PROMPT "" FOR CHAR ans
END IF
RETURN
END IF
IF icon="info" THEN
LET icon="information"
END IF
IF icon != "information"
AND icon != "exclamation"
AND icon != "stop"
AND icon != "question"
THEN
LET icon = NULL
END IF
LET ans = fgl_winQuestion(title,message,1,"OK",icon,0)
END FUNCTION
#+ Prompts for data input.
#+ @returnType String
#+ @return NULL if error.
#+ @param line Line.
#+ @param column Column.
#+ @param message Message.
#+ @param ans Default answer.
#+ @param width Length of input field.
#+ @param type Data type (0=CHAR,1=SMALLINT,2=INTEGER,7=DATE,255=HIDDEN).
FUNCTION fgl_winPrompt(line,column,message,ans,width,type)
DEFINE line INTEGER
DEFINE column INTEGER
DEFINE message String
DEFINE ans String
DEFINE width INTEGER
DEFINE type INTEGER
DEFINE
lgtot INTEGER,
lgmess INTEGER,
newstr CHAR(100),
newint INTEGER,
newdate DATE,
newsma SMALLINT,
endinput SMALLINT,
disp CHAR(512),
errstatus SMALLINT
IF type != 0
AND type != 1
AND type != 2
AND type != 7
AND type != 255
THEN
ERROR "promptat: Unkwon type"
RETURN NULL
END IF
LET lgmess = LENGTH(message)
LET lgtot = LENGTH(message) + width
LET endinput = FALSE
WHILE NOT endinput
WHENEVER ERROR CONTINUE
CASE
WHEN type = 0
PROMPT message CLIPPED ATTRIBUTE(normal) FOR newstr
ON KEY(ACCEPT)
LET endinput = FALSE
END PROMPT
WHEN type = 1
PROMPT message CLIPPED ATTRIBUTE(normal) FOR newsma
ON KEY(ACCEPT)
LET endinput = FALSE
END PROMPT
WHEN type = 2
PROMPT message CLIPPED ATTRIBUTE(normal) FOR newint
ON KEY(ACCEPT)
LET endinput = FALSE
END PROMPT
WHEN type = 7
PROMPT message CLIPPED ATTRIBUTE(normal) FOR newdate
ON KEY(ACCEPT)
LET endinput = FALSE
END PROMPT
WHEN type = 255
PROMPT message CLIPPED ATTRIBUTE(normal) FOR newstr ATTRIBUTE(invisible)
ON KEY(ACCEPT)
LET endinput = FALSE
END PROMPT
END CASE
LET errstatus = status
WHENEVER ERROR STOP
IF int_flag THEN
LET endinput = TRUE
ELSE
IF errstatus < 0 THEN
LET disp = err_get(errstatus)
ERROR disp CLIPPED
ELSE
LET endinput = TRUE
END IF
END IF
END WHILE
CASE
WHEN type = 0
RETURN newstr
WHEN type = 1
RETURN newsma
WHEN type = 2
RETURN newint
WHEN type = 7
RETURN newdate
WHEN type = 255
RETURN newstr
END CASE
RETURN NULL
END FUNCTION
-- fgl_winQuestion
-- Displays a message with fixed choices
-- 1) The function returns case-sensitive localized Strings!
-- 2) The client shows language specific Captions!
#+ Opens window with message and multiple choices.
#+ @returnType String
#+ @return Answer or NULL if error.
#+ @param title Title of the window.
#+ @param message Message to be displayed.
#+ @param ans Default answer.
#+ @param items Pipe separated list of : yes,no,ok,cancel,retry,abort,ignore.
#+ @param icon Icon specification: 'info','exclamation','stop','question'.
#+ @param dang Danger indicator level ( 0, 1, 2, 3 ) - ignored.
FUNCTION fgl_winQuestion(title,message,ans,items,icon,dang)
DEFINE title,message,ans,items,icon String
DEFINE dang Integer # ignored
DEFINE result String
DEFINE answerYes, answerNo, answerOk, answerAbort, answerRetry, answerIgnore, answerCancel String
DEFINE item, uItem String
DEFINE tokenizer base.StringTokenizer
DEFINE styleToUse STRING
IF title is NULL THEN LET title = "" END IF
IF ans is NULL THEN LET ans = "" END IF
IF message is NULL THEN LET message = "" END IF
IF icon is NULL THEN LET icon = "" END IF
LET icon=icon.trimRight()
LET title=title.trimRight()
LET message=message.trimRight()
LET icon=icon.trimRight()
IF icon="info" THEN
LET icon="information"
END IF
IF icon!="information" AND icon!="exclamation" AND icon!="stop"
AND icon!="question" THEN
LET icon = ""
END IF
LET ans=ans.toUpperCase()
LET styleToUse = "winmsg" , fgl_winDialogDirection
MENU title attribute(style=styleToUse,comment=message,image=icon)
BEFORE MENU
HIDE OPTION ALL
LET tokenizer=base.StringTokenizer.create(items,"|")
IF NOT tokenizer.hasMoreTokens() THEN RETURN NULL END IF
WHILE tokenizer.hasMoreTokens()
LET item=tokenizer.nextToken()
LET uItem = item.toUpperCase()
CASE
WHEN uitem = "JA" OR uitem = "OUI" OR uitem="YES"
SHOW OPTION "yes"
LET answerYes=item
IF ans==uitem then NEXT OPTION "yes" END IF
WHEN uitem = "NO" OR uitem = "NEIN" OR uitem="NON"
SHOW OPTION "no"
LET answerNo=item
IF ans==uItem then NEXT OPTION "no" END IF
WHEN uItem = "OK"
SHOW OPTION "ok"
LET answerOk= item
IF ans==uItem then NEXT OPTION "ok" END IF
WHEN uitem="CANCEL" OR uitem="INTERROMPRE" OR uitem="UNTERBRECHEN"
OR uItem="INTERRUPT" OR uItem="ANNULER"
SHOW OPTION "cancel"
LET answerCancel=item
IF ans==uItem THEN NEXT OPTION "cancel" END IF
WHEN uitem="WIEDERHOLEN" OR uitem="REPETER" OR uitem="RETRY"
SHOW OPTION "retry"
LET answerRetry=item
IF ans==uItem then NEXT OPTION "retry" END IF
WHEN uitem="IGNORER" OR uitem="IGNORE"
OR uitem="IGNORIEREN" OR uitem="UEBERGEHEN" OR uitem="_BERGEHEN"
SHOW OPTION "ignore"
LET answerIgnore=item
IF ans==uItem THEN NEXT OPTION "ignore" END IF
WHEN uitem="ABANDON" OR uitem="ABORT" OR uitem="ABBRECHEN"
SHOW OPTION "abort"
let answerAbort=item
IF ans==uItem THEN NEXT OPTION "abort" END IF
OTHERWISE
ERROR "Bad option '",item,"' in function fgl_winquestion"
RETURN NULL
END CASE
END WHILE
COMMAND "yes"
LET result=answerYes
COMMAND "no"
LET result=answerNo
COMMAND "ok"
LET result=answerOk
COMMAND "abort"
LET result=answerAbort
COMMAND "retry"
LET result=answerRetry
COMMAND "ignore"
LET result=answerIgnore
COMMAND "cancel"
LET result=answerCancel
END MENU
RETURN result
END FUNCTION
#+ Display a message and wait for a key press.
#+ @param message Message to be displayed.
FUNCTION fgl_winWait(message)
DEFINE message String
DEFINE l SMALLINT
DEFINE c SMALLINT
DEFINE win SMALLINT
DEFINE ans CHAR(1)
DEFINE lg SMALLINT
IF NOT fgl_fglGui() THEN
LET lg = LENGTH(message)
IF win AND l AND c AND lg THEN
OPEN WINDOW w_wait AT l, c WITH 1 ROWS, lg COLUMNS ATTRIBUTE (BORDER)
PROMPT message CLIPPED FOR CHAR ans
CLOSE WINDOW w_wait
ELSE
IF lg>0 THEN
PROMPT message CLIPPED FOR CHAR ans
ELSE
PROMPT "" FOR CHAR ans
END IF
END IF
RETURN
END IF
LET ans = fgl_winQuestion("",message,1,"OK","",0)
END FUNCTION
#+ Checks UI client to be WTK.
#+ @returnType Integer
#+ @return TRUE if the UI is a WTK.
FUNCTION fgl_wtkClient()
DEFINE uiName String
LET uiName=ui.Interface.getFrontEndName()
IF uiName IS NOT NULL then
IF uiName.equals("Wtk") THEN
RETURN 1
END IF
END IF
RETURN 0
END FUNCTION
FUNCTION fgl_setWinDialogDirectionRightToLeft()
LET fgl_winDialogDirection = " rightToLeft"
END FUNCTION
FUNCTION fgl_setWinDialogDirectionLeftToRight()
LET fgl_winDialogDirection = " leftToRight"
END FUNCTION
-- fgl_fixedcomment