Panel doesn't execute )PNTS Section - rexx

I'm coding a ISPF Panel with "Point and shoot" elements. The elements say "yes" and "no" and the default cursor have to point to "yes".
1st Case:
Declaration of the fields: + TYPE(INPUT) PAS(ON)
When I use this declaration, the panel closes by pressing [enter] and generating rc = 0. However, the )PNTS section doesn't run.
2nd CASE:
Declaration of the fields: + TYPE (PS)
The )PNTS section runs by pressing [enter]. However, I cannot set the .cursor to the field "yes".
I tryed different ways with different field names (e.g. ZPS00001). I tryed to simulate Point and Shoot with Rexx, but nothing worked really fine.

Pressing enter will cause the point and shoot fields to be processed. However the cursor must be on one of the fields for the )PNTS section to set the value associated with a field. It would sound like panel may have not been coded correctly. PAS should be used for input or output fields and PS should be used for text fields. For instance if you have the following panel:
)ATTR
$ TYPE(PS)
! TYPE(OUTPUT) PAS(ON)
)BODY
+ --------------------- +
+ ===>_ZCMD +
+
$Field1 : _FLD +
$Field2 : _ABC +
$Field3 : !IN1 +
$Field4 : !IN2 +
)INIT
&INV1 = 111
&INV2 = 222
&INV3 = 333
)REINIT
REFRESH(*)
)PROC
)PNTS
FIELD(IN1) VAR(INV1) VAL(ON)
FIELD(IN2) VAR(INV2) VAL(OFF)
FIELD(ZPS00001) VAR(INV3) VAL(1)
FIELD(ZPS00002) VAR(INV3) VAL(2)
FIELD(ZPS00003) VAR(INV3) VAL(3)
FIELD(ZPS00004) VAR(INV3) VAL(4)
)END
With the following REXX exec:
/* REXX */
RCC = 0
INV1 = 0
INV2 = 1
DO WHILE RCC = 0
ADDRESS ISPEXEC 'DISPLAY PANEL(PAS)'
RCC = RC
SAY INV1 '-' INV2 '-' INV3
END
You can test the values of inv1, inv2 and inv3 based on where you put the cursor when you hit enter. You will get 1, 2, 3 or 4 if the cursor in on field1, field2, field3 or field4. If it is on IN1 or IN2 then you get ON or OFF. It all depends on where the cursor is positioned when ENTER is hit. Based on the example you can see point and shoot is not limited to Menus. Hope the example helps.
Marv Knight

Related

Save job output from SDSF into a PDS and using ISPF functions in REXX

We periodically runs jobs and we need to save the output into a PDS and then parse the output to extract parts of it to save into another member. It needs to be done by issuing a REXX command using the percent sign and the REXX member name as an SDSF command line. I've attempted to code a REXX to do this, but it is getting an error when trying to invoke an ISPF service, saying the ISPF environment has not been established. But, this is SDSF running under ISPF.
My code has this in it (copied from several sources and modified):
parse arg PSDSFPARMS "(" PUSERPARMS
parse var PSDSFPARMS PCURRPNL PPRIMPNL PROWTOKEN PPRIMCMD .
PRIMCMD=x2c(PPRIMCMD)
RC = isfquery()
if RC <> 0 then
do
Say "** SDSF environment does not exist, exec ending."
exit 20
end
RC = isfcalls("ON")
Address SDSF "ISFGET" PPRIMPNL "TOKEN('"PROWTOKEN"')" ,
" (" VERBOSE ")"
LRC = RC
if LRC > 0 then
call msgrtn "ISFGET"
if LRC <> 0 then
Exit 20
JOBNAME = value(JNAME.1)
JOBNBR = value(JOBID.1)
SMPDSN = "SMPE.*.OUTPUT.LISTINGS"
LISTC. = ''
SMPODSNS. = ''
SMPODSNS.0 = 0
$ = outtrap('LISTC.')
MSGVAL = msg('ON')
address TSO "LISTC LVL('"SMPDSN"') ALL"
MSGVAL = msg(MSGVAL)
$ = outtrap('OFF')
do LISTCi = 1 to LISTC.0
if word(LISTC.LISTCi,1) = 'NONVSAM' then
do
parse var LISTC.LISTCi . . DSN
SMPODSNS.0 = SMPODSNS.0 + 1
i = SMPODSNS.0
SMPODSNS.i = DSN
end
IX = pos('ENTRY',LISTC.LISTCi)
if IX <> 0 then
do
IX = pos('NOT FOUND',LISTC.LISTCi,IX + 8)
if IX <> 0 then
do
address ISPEXEC "SETMSG MSG(IPLL403E)"
EXITRC = 16
leave
end
end
end
LISTC. = ''
if EXITRC = 16 then
exit 0
address ISPEXEC "TBCREATE SMPDSNS NOWRITE" ,
"NAMES(TSEL TSMPDSN)"
I execute this code by typing %SMPSAVE next to the spool output line on the "H" SDSF panel and it runs fine until it gets to this point in the REXX:
114 *-* address ISPEXEC "TBCREATE SMPDSNS NOWRITE" ,
"NAMES(TSEL TSMPDSN)"
>>> "TBCREATE SMPDSNS NOWRITE NAMES(TSEL TSMPDSN)"
ISPS118S SERVICE NOT INVOKED. A VALID ISPF ENVIRONMENT DOES NOT EXIST.
+++ RC(20) +++
Does anyone know why it says I don't have a valid ISPF environment and how I can get around this?
I've done quite a bit in the past with REXX, including writing REXX code to handle line commands, but this is the first time I've tried to use ISPEXEC commands within this code.
Thank you,
Alan

Updating my current script which modifies multiple lines into a single one

My current script copies text like this with a shortcut:
:WiltedFlower: aetheryxflower ─ 4
:Alcohol: alcohol ─ 3,709
:Ant: ant ─ 11,924
:Apple: apple ─ 15
:ArmpitHair: armpithair ─ 2
and pastes it modified into a single line
Pls trade 4 aetheryxflower 3 alcohol 11 ant 15 apple 2 armpithair <#id>
As you can see there are already two little problems, the first one is that it copies only the number/s before a comma if one existed instead of ignoring it. The second is that I always need to also copy before hitting the hotkey and start re/start the script, I've thought of modifying the script so that it uses the already selected text instead of the copied one so that I can bind it with a single hotkey.
That is my current script, it would be cool if anyone can also tell me what they used and why exactly, so that I also get better with ahk
!q::
list =
While pos := RegExMatch(Clipboard, "(\w*) ─ (\d*)", m, pos ? pos + StrLen(m) : 1)
list .= m2 " " m1 " "
Clipboard := "", Clipboard := "Pls trade " list " <#951737931159187457>"
ClipWait, 0
If ErrorLevel
MsgBox, 48, Error, An error occurred while waiting for the clipboard.
return
If the pattern of your copied text dont change, you can use something like this:
#Persistent
OnClipboardChange:
list =
a := StrSplit(StrReplace(Clipboard, "`r"), "`n")
Loop,% a.Count() {
b := StrSplit( a[A_Index], ": " )
c := StrSplit( b[2], " - " )
list .= Trim( c[2] ) " " Trim( c[1] ) " "
}
Clipboard := "Pls trade " list " <#951737931159187457>"]
ToolTip % Clipboard ; just for debug
return
With your example text, the output will be:
Pls trade aetheryxflower ─ 4 alcohol ─ 3,709 ant ─ 11,924 apple ─ 15 armpithair ─ 2 <#951737931159187457>
And this will run EVERY TIME your clipboard changes, to avoid this, you can add at the top of the script #IfWinActive, WinTitle or #IfWinExist, WinTitle depending of your need.
The answer given would solve the problem, assuming that it never changes pattern as Diesson mentions.
I did the explanation of the code you provided with comments in the code below:
!q::
list = ; initalize a blank variable
; regexMatch(Haystack, regexNeedle, OutputVar, startPos)
; just for frame of reference in explanation of regexMatch
While ; loop while 'pos' <> 0
pos := RegExMatch(Clipboard ; Haystack is the string to be searched,
in this case the Clipboard
, "(\w*) ─ (\d*)" ; regex needle in this case "capture word characters
(a-z OR A-Z OR 0-9 OR _) any number of times, space dash space
then capture any number of digits (0-9)"
, m ; output var array base name, ie first capture will be in m1
second m2 and so on.
, pos ? pos + StrLen(m) : 1) ; starting position for search
"? :"used in this way is called a ternary operator, what is saying
is "if pos<>0 then length of string+pos is start position, otherwise
start at 1". Based on the docs, this shouldn't actually work well
since 'm' in this case should be left blank
list .= m2 " " m1 " " ; append the results to the 'list' variable
followed with a space
Clipboard := "" ; clear the clipboard.
Clipboard := "Pls trade " list " <#951737931159187457>"
ClipWait, 0 ; wait zero seconds for the clipboard to change
If ErrorLevel ; if waiting zero seconds for the clipboard to change
doesn't work, give error msg to user.
MsgBox, 48, Error, An error occurred while waiting for the clipboard.
return
Frankly this code is what I would call quick and dirty, and seems unlikely to work well all the time.

CLLE SNDRCVF command not allowed

I am trying to compile this piece of CL code using Rational Series but keep getting error.
This is my CL code:
PGM
DCLF FILE(LAB4DF)
SNDRCVF RCDFMT(RECORD1) /* send, recieve file */
DOWHILE (&IN03 = '0')
SELECT
WHEN (&USERINPUT = '1' *OR &USERINPUT = '01') CALLSUBR OPTION1
OTHERWISE DO
*IN03 = '1'
ENDDO
ENDSELECT
ENDDO
SUBR OPTION1
DSPLIBL
ENDSUBR
ENDPGM
And this is my DSPF code
A R RECORD1
A 1 38'LAB 4'
A 3 3'Please select one of the following-
A options:'
A 6 11'3. Maximum Invalid Signon Attempt-
A s allowed'
A 8 11'5. Run Instructor''s Insurance Pr-
A ogram'
A 5 11'2. Signed on User''s Message Queu-
A e'
A 1 3'Yathavan Parameshwaran'
A 7 11'4. Initial number of active jobs -
A for storage allocation'
A 4 11'1. Previous sign on by signed on -
A user'
A 14 11'F3 = Exit'
A 14 31'F21 = Command Line'
A 2 70TIME
A 1 72DATE
A 9 11'Option: '
A USERINPUT 2 B 9 19
A 91 DSPATR(RI)
A 92 DSPATR(PC)
A MSGTXT1 70 O 11 11
A MSGTXT2 70 O 12 11
Is there a problem with my CL code or DSPF code?
You forgot to say what error you were getting. It's always important to put all the information about error messages into your questions.
There are two errors.
&IN03 is not defined
Your assignment to *IN03 should be to &IN03, but that's not how you do an assignment in CLP
If you want to be able to press F3, you have to code something like CA03(03) in the "Functions" for the record format.
To assign a variable in CL, code
CHGVAR name value
Looking at the documentation here, I suspect you need to add RCDFMT to your DCLF spec like so:
DCLF FILE(LAB4DF) RCDFMT(RECORD1)
SNDRCVF RCDFMT(RECORD1) /* send, recieve file */
If you really do only have 1 record format in your display file, then you can also omit the RCDFMT from both commands like so:
DCLF FILE(LAB4DF)
SNDRCVF /* send, recieve file */

Fitting custom functions to data

I have a series of data, for example:
0.767838478
0.702426493
0.733858228
0.703275979
0.651456058
0.62427187
0.742353261
0.646359026
0.695630431
0.659101665
0.598786652
0.592840135
0.59199059
which I know fits best to an equation of the form:
y=ae^(b*x)+c
How can I fit the custom function to this data?
Similar question had been already asked on LibreOffice forum without a proper answer. I would appreciate if you could help me know how to do this. Preferably answers applying to any custom function rather than workarounds to this specific case.
There are multiple possible solutions for this. But one approach would be the following:
For determining the aand b in the trend line function y = a*e^(b*x) there are solutions using native Calc functions (LINEST, EXP, LN).
So we could the y = a*e^(b*x)+c taking as y-c= a*e^(b*x) and so if we are knowing c, the solution for y = a*e^(b*x) could be taken too. How to know c? One approach is described in Exponential Curve Fitting. There approximation of b, a and then c are made.
I have the main part of the delphi code from Exponential Curve Fitting : source listing translated to StarBasic for Calc. The part of the fine tuning of c is not translated until now. To-Do for you as professional and enthusiast programmers.
Example:
Data:
x y
0 0.767838478
1 0.702426493
2 0.733858228
3 0.703275979
4 0.651456058
5 0.62427187
6 0.742353261
7 0.646359026
8 0.695630431
9 0.659101665
10 0.598786652
11 0.592840135
12 0.59199059
Formulas:
B17: =EXP(INDEX(LINEST(LN($B$2:$B$14),$A$2:$A$14),1,2))
C17: =INDEX(LINEST(LN($B$2:$B$14),$A$2:$A$14),1,1)
y = a*e^(b*x) is also the function used for the chart's trend line calculation.
B19: =INDEX(TRENDEXPPLUSC($B$2:$B$14,$A$2:$A$14),1,1)
C19: =INDEX(TRENDEXPPLUSC($B$2:$B$14,$A$2:$A$14),1,2)
D19: =INDEX(TRENDEXPPLUSC($B$2:$B$14,$A$2:$A$14),1,3)
Code:
function trendExpPlusC(rangey as variant, rangex as variant) as variant
'get values from ranges
redim x(ubound(rangex)-1) as double
redim y(ubound(rangex)-1) as double
for i = lbound(x) to ubound(x)
x(i) = rangex(i+1,1)
y(i) = rangey(i+1,1)
next
'make helper arrays
redim dx(ubound(x)-1) as double
redim dy(ubound(x)-1) as double
redim dxyx(ubound(x)-1) as double
redim dxyy(ubound(x)-1) as double
for i = lbound(x) to ubound(x)-1
dx(i) = x(i+1) - x(i)
dy(i) = y(i+1) - y(i)
dxyx(i) = (x(i+1) + x(i))/2
dxyy(i) = dy(i) / dx(i)
next
'approximate b
s = 0
errcnt = 0
for i = lbound(dxyx) to ubound(dxyx)-1
on error goto errorhandler
s = s + log(abs(dxyy(i+1) / dxyy(i))) / (dxyx(i+1) - dxyx(i))
on error goto 0
next
b = s / (ubound(dxyx) - errcnt)
'approximate a
s = 0
errcnt = 0
for i = lbound(dx) to ubound(dx)
on error goto errorhandler
s = s + dy(i) / (exp(b * x(i+1)) - exp(b * x(i)))
on error goto 0
next
a = s / (ubound(dx) + 1 - errcnt)
'approximate c
s = 0
errcnt = 0
for i = lbound(x) to ubound(x)
on error goto errorhandler
s = s + y(i) - a * exp(b * x(i))
on error goto 0
next
c = s / (ubound(x) + 1 - errcnt)
'make y for (y - c) = a*e^(b*x)
for i = lbound(x) to ubound(x)
y(i) = log(abs(y(i) - c))
next
'get a and b from LINEST for (y - c) = a*e^(b*x)
oFunctionAccess = createUnoService( "com.sun.star.sheet.FunctionAccess" )
args = array(array(y), array(x))
ab = oFunctionAccess.CallFunction("LINEST", args)
if a < 0 then a = -exp(ab(0)(1)) else a = exp(ab(0)(1))
b = ab(0)(0)
trendExpPlusC = array(a, b, c)
exit function
errorhandler:
errcnt = errcnt + 1
resume next
end function
The formula y = beax is the exponential regression equation for LibreOffice chart trend lines.
LibreOffice exports all settings
All the settings of LibreOffice, all in the LibreOffice folder.
C:\Users\a←When installing the operating system, the name
entered.\AppData←File Manager ~ "Hidden project" to open, the AppData
folder will be displayed.\Roaming\LibreOffice
Back up the LibreOffice folder, when reinstalling, put the LibreOffice folder in its original place.
Note:
1. If the installation is preview edition, because the name of preview edition is LibreOfficeDev, so the LibreOfficeDev folder will be
displayed.
2. Formal edition can be installed together with preview edition, if both formal edition and preview edition are installed, LibreOffice
folder and LibreOfficeDev folder will be displayed.
3. To clear all settings, just delete the LibreOffice folder, then open the program, a new LibreOffice folder will be created.
LibreOffice exports a single toolbar I made
Common path
C:\Users\a←When installing the operating system, the name
entered.\AppData←File Manager ~ "Hidden project" to open, the AppData
folder will be
displayed.\Roaming\LibreOffice\4\user\config\soffice.cfg\modules\Please
connect the branch path of the individual software below.
Branch path
\modules\StartModule\toolbar\The "Start" toolbar I made is placed here.
\modules\swriter\toolbar\The "writer" toolbar I made is placed here.
\modules\scalc\toolbar\The "calc" toolbar I made is placed here.
\modules\simpress\toolbar\The "impress" toolbar I made is placed here.
\modules\sdraw\toolbar\The "draw" toolbar I made is placed here.
\modules\smath\toolbar\The "math" toolbar I made is placed here.
\modules\dbapp\toolbar\The "base" toolbar I made is placed here.
Backup file, when reinstalling, put the file in the original place.
Note:
Because of the toolbar that I made myself, default file name, will automatically use Numbering, so to open the file, can know the name of
the toolbar.
The front file name "custom_toolbar_" cannot be changed, change will cause error, behind's file name can be changed. For example:
custom_toolbar_c01611ed.xml→custom_toolbar_AAA.xml.
Do well of toolbar, can be copied to other places to use. For example: In the "writer" Do well of toolbar, can be copied to "calc"
places to use.
LibreOffice self-made symbol toolbar
Step 1 Start "Recording Macros function" Tools\Options\Advanced\Enable macro recording(Tick), in the
"Tools\Macros", the "Record Macro" option will appear.
Step 2 Recording Macros Tools\Macros\Record Macro→Recording action (click "Ω" to enter symbol→select symbol→Insert)→Stop
Recording→The name Macros stored in "Module1" is Main→Modify Main
name→Save.
Step 3 Add item new toolbar Tools\Customize\Toolbar→Add→Enter a name (example: symbol)→OK, the new toolbar will appear in the top
left.
Step 4 Will Macros Add item new toolbar Tools\Customize\Toolbar\Category\Macros\My
Macros\Standard\Module1\Main→Click "Main"→Add item→Modify→Rename (can
be named with symbol)→OK→OK.

String Concatenating functions in Progress 4GL?

I came across a function in C#, string.Join() which is really helpful for string concatenation.
I am wondering is there any possibility of doing the same functionality in Progress 4GL ?
Typical C# example would be,
String result = “ ”;
result = string.Join(",", this.grpBox1.Controls.OfType<CheckBox>()
.Where(x => x.Checked)
.Select(c => c.Text));
MessageBox.Show(result);
I am not trying to convert C# to Progress but it would be really helpful if i could achieve the same functionality in Progress.
if you do really want your function you could wrap it and declare it as external you can re-link _progres to include your own c libs. used to be called HLC (probuild) but now its a set of scripts under a new directory name oebuild directly under the Progress install directory(DLC). The hlc and make directories are under the oebuild directory.
Instructions on the build process can be found in the README file located in the oebuild directory under the DLC directory. Prob. a sledge hammer to crack a nut you would have to understand what your doing not for the faint of heart. but if you have something written in c you want to call you can do it. prob. best to stick to the 4gl nearest thing progress has to arrays is extent not used much most people break out to a temp table . rows in a tt are far easier to handle and iterate so its a "mind set" switch a bit.
Important comments can also be found in the hlprodsp.c file located in the hlc directory, a subdirectory of oebuild.
As far as I know, there's nothing built in to that effort. But if I understand correctly, when you issue that command you get a list of that given object type (in your example, checkbox) as a CSV.
I built something that resembles it, as a start to whatever you'd like to implement. It's probably far from perfect, but it works for me. It's a window with various widget types, you select from the combo the type you'd like to search and generate, and it will show you at the end the values of two CSV variables: one with the widget names that match that type, and one with the respective values.
Here it goes:
&Scoped-define WINDOW-NAME C-Win
/*------------------------------------------------------------------------
File:
Description:
Input Parameters:
<none>
Output Parameters:
<none>
Author:
Created:
------------------------------------------------------------------------*/
/* This .W file was created with the Progress AppBuilder. */
/*----------------------------------------------------------------------*/
/* Create an unnamed pool to store all the widgets created
by this procedure. This is a good default which assures
that this procedure's triggers and internal procedures
will execute in this procedure's storage, and that proper
cleanup will occur on deletion of the procedure. */
CREATE WIDGET-POOL.
/* *************************** Definitions ************************** */
/* Parameters Definitions --- */
/* Local Variable Definitions --- */
DEFINE VARIABLE cWidgetLst AS CHARACTER NO-UNDO.
DEFINE VARIABLE cValueLst AS CHARACTER NO-UNDO.
/* ******************** Preprocessor Definitions ******************** */
&Scoped-define PROCEDURE-TYPE Window
&Scoped-define DB-AWARE no
/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME DEFAULT-FRAME
/* Standard List Definitions */
&Scoped-Define ENABLED-OBJECTS COMBO-BOX-1 BUTTON-1 SLIDER-1 SELECT-1 ~
RADIO-SET-1 TOGGLE-1 FILL-IN-2 COMBO-BOX-3
&Scoped-Define DISPLAYED-OBJECTS COMBO-BOX-1 SLIDER-1 SELECT-1 RADIO-SET-1 ~
TOGGLE-1 FILL-IN-2 COMBO-BOX-3
/* Custom List Definitions */
/* List-1,List-2,List-3,List-4,List-5,List-6 */
/* *********************** Control Definitions ********************** */
/* Define the widget handle for the window */
DEFINE VAR C-Win AS WIDGET-HANDLE NO-UNDO.
/* Definitions of the field level widgets */
DEFINE BUTTON BUTTON-1
LABEL "Generate"
SIZE 15 BY 1.14.
DEFINE VARIABLE COMBO-BOX-1 AS CHARACTER FORMAT "X(256)":U
VIEW-AS COMBO-BOX INNER-LINES 5
LIST-ITEMS "Fill-in","Radio-set","Toggle-box","Selection-List","slider","combo-box"
DROP-DOWN-LIST
SIZE 16 BY 1 NO-UNDO.
DEFINE VARIABLE COMBO-BOX-3 AS CHARACTER FORMAT "X(256)":U
LABEL "Combo 3"
VIEW-AS COMBO-BOX INNER-LINES 5
LIST-ITEMS "Large","Tall","Venti"
DROP-DOWN-LIST
SIZE 16 BY 1 NO-UNDO.
DEFINE VARIABLE FILL-IN-2 AS CHARACTER FORMAT "X(256)":U
LABEL "Fill 2"
VIEW-AS FILL-IN
SIZE 14 BY 1 NO-UNDO.
DEFINE VARIABLE RADIO-SET-1 AS INTEGER
VIEW-AS RADIO-SET VERTICAL
RADIO-BUTTONS
"Item 1", 1,
"Item 2", 2,
"Item 3", 3
SIZE 12 BY 3 NO-UNDO.
DEFINE VARIABLE SELECT-1 AS CHARACTER
VIEW-AS SELECTION-LIST SINGLE SCROLLBAR-VERTICAL
LIST-ITEMS "First","Second","Third"
SIZE 23 BY 2 NO-UNDO.
DEFINE VARIABLE SLIDER-1 AS INTEGER INITIAL 0
VIEW-AS SLIDER MIN-VALUE 0 MAX-VALUE 100 HORIZONTAL
TIC-MARKS NONE
SIZE 31 BY 2.38 NO-UNDO.
DEFINE VARIABLE TOGGLE-1 AS LOGICAL INITIAL no
LABEL "Toggle 1"
VIEW-AS TOGGLE-BOX
SIZE 13.4 BY .81 NO-UNDO.
DEFINE VARIABLE COMBO-BOX-2 AS CHARACTER FORMAT "X(256)":U
LABEL "Combo 2"
VIEW-AS COMBO-BOX INNER-LINES 5
LIST-ITEMS "Item 1"
DROP-DOWN-LIST
SIZE 16 BY 1 NO-UNDO.
DEFINE VARIABLE FILL-IN-3 AS CHARACTER FORMAT "X(256)":U
LABEL "Fill 3"
VIEW-AS FILL-IN
SIZE 14 BY 1 NO-UNDO.
DEFINE VARIABLE RADIO-SET-2 AS INTEGER
VIEW-AS RADIO-SET VERTICAL
RADIO-BUTTONS
"Item 1", 1,
"Item 2", 2,
"Item 3", 3
SIZE 12 BY 3 NO-UNDO.
DEFINE VARIABLE SLIDER-2 AS INTEGER INITIAL 0
VIEW-AS SLIDER MIN-VALUE 0 MAX-VALUE 100 HORIZONTAL
TIC-MARKS NONE
SIZE 17 BY 2.14 NO-UNDO.
DEFINE VARIABLE TOGGLE-2 AS LOGICAL INITIAL no
LABEL "Toggle 2"
VIEW-AS TOGGLE-BOX
SIZE 13.4 BY .81 NO-UNDO.
/* ************************ Frame Definitions *********************** */
DEFINE FRAME DEFAULT-FRAME
COMBO-BOX-1 AT ROW 1.95 COL 13 COLON-ALIGNED NO-LABEL WIDGET-ID 14
BUTTON-1 AT ROW 1.95 COL 32 WIDGET-ID 2
SLIDER-1 AT ROW 3.62 COL 42 NO-LABEL WIDGET-ID 18
SELECT-1 AT ROW 3.86 COL 10 NO-LABEL WIDGET-ID 16
RADIO-SET-1 AT ROW 6.24 COL 10 NO-LABEL WIDGET-ID 6
TOGGLE-1 AT ROW 6.24 COL 30 WIDGET-ID 10
FILL-IN-2 AT ROW 7.19 COL 28 COLON-ALIGNED WIDGET-ID 12
COMBO-BOX-3 AT ROW 7.29 COL 56 COLON-ALIGNED WIDGET-ID 20
WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
SIDE-LABELS NO-UNDERLINE THREE-D
AT COL 1 ROW 1
SIZE 80 BY 16 WIDGET-ID 100.
DEFINE FRAME FRAME-A
TOGGLE-2 AT ROW 1.24 COL 51 WIDGET-ID 6
RADIO-SET-2 AT ROW 1.48 COL 3 NO-LABEL WIDGET-ID 2
FILL-IN-3 AT ROW 1.95 COL 25 COLON-ALIGNED WIDGET-ID 8
SLIDER-2 AT ROW 3.14 COL 46 NO-LABEL WIDGET-ID 12
COMBO-BOX-2 AT ROW 3.38 COL 24 COLON-ALIGNED WIDGET-ID 10
WITH 1 DOWN KEEP-TAB-ORDER OVERLAY
SIDE-LABELS NO-UNDERLINE THREE-D
AT COL 5 ROW 10.29
SIZE 72 BY 5.71
TITLE "Frame A" WIDGET-ID 200.
/* *********************** Procedure Settings ************************ */
/* Settings for THIS-PROCEDURE
Type: Window
Allow: Basic,Browse,DB-Fields,Window,Query
Other Settings: COMPILE
*/
/* ************************* Create Window ************************** */
IF SESSION:DISPLAY-TYPE = "GUI":U THEN
CREATE WINDOW C-Win ASSIGN
HIDDEN = YES
TITLE = "<insert window title>"
HEIGHT = 16
WIDTH = 80
MAX-HEIGHT = 16
MAX-WIDTH = 80
VIRTUAL-HEIGHT = 16
VIRTUAL-WIDTH = 80
RESIZE = yes
SCROLL-BARS = no
STATUS-AREA = no
BGCOLOR = ?
FGCOLOR = ?
KEEP-FRAME-Z-ORDER = yes
THREE-D = yes
MESSAGE-AREA = no
SENSITIVE = yes.
ELSE {&WINDOW-NAME} = CURRENT-WINDOW.
/* END WINDOW DEFINITION */
/* *********** Runtime Attributes and AppBuilder Settings *********** */
/* SETTINGS FOR WINDOW C-Win
VISIBLE,,RUN-PERSISTENT */
/* REPARENT FRAME */
ASSIGN FRAME FRAME-A:FRAME = FRAME DEFAULT-FRAME:HANDLE.
/* SETTINGS FOR FRAME DEFAULT-FRAME
FRAME-NAME */
DEFINE VARIABLE XXTABVALXX AS LOGICAL NO-UNDO.
ASSIGN XXTABVALXX = FRAME FRAME-A:MOVE-AFTER-TAB-ITEM (COMBO-BOX-3:HANDLE IN FRAME DEFAULT-FRAME)
/* END-ASSIGN-TABS */.
/* SETTINGS FOR FRAME FRAME-A
*/
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN C-Win:HIDDEN = no.
/* ************************ Control Triggers ************************ */
&Scoped-define SELF-NAME C-Win
ON END-ERROR OF C-Win /* <insert window title> */
OR ENDKEY OF {&WINDOW-NAME} ANYWHERE DO:
/* This case occurs when the user presses the "Esc" key.
In a persistently run window, just ignore this. If we did not, the
application would exit. */
IF THIS-PROCEDURE:PERSISTENT THEN RETURN NO-APPLY.
END.
ON WINDOW-CLOSE OF C-Win /* <insert window title> */
DO:
/* This event will close the window and terminate the procedure. */
APPLY "CLOSE":U TO THIS-PROCEDURE.
RETURN NO-APPLY.
END.
&Scoped-define SELF-NAME BUTTON-1
ON CHOOSE OF BUTTON-1 IN FRAME DEFAULT-FRAME /* Generate */
DO:
assign cWidgetLst = ''
cValueLst = ''.
run downTheRabbitHole ( input {&window-name}:handle).
MESSAGE cWidgetLst SKIP cValueLst
VIEW-AS ALERT-BOX INFO BUTTONS OK.
END.
&UNDEFINE SELF-NAME
/* *************************** Main Block *************************** */
/* Set CURRENT-WINDOW: this will parent dialog-boxes and frames. */
ASSIGN CURRENT-WINDOW = {&WINDOW-NAME}
THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}.
/* The CLOSE event can be used from inside or outside the procedure to */
/* terminate it. */
ON CLOSE OF THIS-PROCEDURE
RUN disable_UI.
/* Best default for GUI applications is... */
PAUSE 0 BEFORE-HIDE.
/* Now enable the interface and wait for the exit condition. */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire. */
MAIN-BLOCK:
DO ON ERROR UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
RUN enable_UI.
IF NOT THIS-PROCEDURE:PERSISTENT THEN
WAIT-FOR CLOSE OF THIS-PROCEDURE.
END.
/* ********************** Internal Procedures *********************** */
PROCEDURE buildCSV :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEFINE INPUT-OUTPUT PARAMETER iopcList AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER ipcValue AS CHARACTER NO-UNDO.
if ipcValue = ? then
assign ipcValue = '?'.
if ipcValue = '' then
assign ipcValue = ' '.
assign iopcList = iopcList + (if iopcList = '' then '' else ',') + ipcValue.
END PROCEDURE.
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
Purpose: DISABLE the User Interface
Parameters: <none>
Notes: Here we clean-up the user-interface by deleting
dynamic widgets we have created and/or hide
frames. This procedure is usually called when
we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
/* Delete the WINDOW we created */
IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(C-Win)
THEN DELETE WIDGET C-Win.
IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
END PROCEDURE.
PROCEDURE downTheRabbitHole :
/*------------------------------------------------------------------------------
Purpose:
Parameters: <none>
Notes:
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER iphWidget AS HANDLE NO-UNDO.
DEFINE VARIABLE hHandle AS HANDLE NO-UNDO.
assign hHandle = iphWidget:first-child.
do while valid-handle(hHandle):
if can-query(hHandle,"type") and hHandle:type = combo-box-1:screen-value in frame {&frame-name} then do:
/* something something something dark side... */
if can-query(hHandle,"name") then run buildCSV(input-output cWidgetLst,hHandle:name).
if can-query(hHandle,"screen-value") then run buildCSV(input-output cValueLst,hHandle:screen-value).
end.
if hHandle:type = "FIELD-GROUP" or hHandle:type = "FRAME" then
run downTheRabbitHole(input hHandle:first-child).
assign hHandle = hHandle:next-sibling.
end.
END PROCEDURE.
PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
Purpose: ENABLE the User Interface
Parameters: <none>
Notes: Here we display/view/enable the widgets in the
user-interface. In addition, OPEN all queries
associated with each FRAME and BROWSE.
These statements here are based on the "Other
Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
DISPLAY COMBO-BOX-1 SLIDER-1 SELECT-1 RADIO-SET-1 TOGGLE-1 FILL-IN-2
COMBO-BOX-3
WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
ENABLE COMBO-BOX-1 BUTTON-1 SLIDER-1 SELECT-1 RADIO-SET-1 TOGGLE-1 FILL-IN-2
COMBO-BOX-3
WITH FRAME DEFAULT-FRAME IN WINDOW C-Win.
{&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME}
DISPLAY TOGGLE-2 RADIO-SET-2 FILL-IN-3 SLIDER-2 COMBO-BOX-2
WITH FRAME FRAME-A IN WINDOW C-Win.
ENABLE TOGGLE-2 RADIO-SET-2 FILL-IN-3 SLIDER-2 COMBO-BOX-2
WITH FRAME FRAME-A IN WINDOW C-Win.
{&OPEN-BROWSERS-IN-QUERY-FRAME-A}
VIEW C-Win.
END PROCEDURE.