This procedure displays a popup menu and let the user select between a max of 15 options.
You can select between various styles of presenting the menu, various border types and various locations on the screen. When the user have selected an option, the option number is returned to the caller.
The menu is dynamic and adapt it’s size to the number of options, the width of the Title, Footer, F-key text and the Options. This is possible as the popup procedure makes call to the Dynamic Screen Manager to create and maintain the popup window. The procedure is written in Totally Free RPG.
The Popup Menu procedure supports screen sizes *DS3 (24×80) and *DS4 (27×132).
Download:
- Source members as text files: PopMnuSources
The zip file contains the source members. Extract the source files and transfer them to your IBM i.
To display a popup menu to the user, and manage it, you must call the PopupMenu() procedure with the parameters:
PopupMenu(location: row: col: border: style: remove_menu: title: header: footer: fkey_text: options(15))
Where the parameters are:
- location
The location where to display the menu:
pmLocationCenter
The menu will be centered on the screen.
pmLocationCursor
The menu’s top left corner will be displayed just below the cursor.
pmLocationRowCol
The menu’s top left corner will be display at row given in parameter ROW and column given in parameter COL. - border
The layout of the popup menu border:
pmBorderDefault
If the terminal supports GUI, then the border is displayed with a GUI standard border. If the terminal only supports character mode, then the border is displayed using characters.
pmBorderReverseBlue
No matter if the terminal supports GUI or not, the border is displayed in Reverse Image in blue colour.
pmBorderReverseGreen
No matter if the terminal supports GUI or not, the border is displayed in Reverse Image in green colour.
pmBorderAlert
No matter if the terminal supports GUI or not, the border is displayed in Reverse Image in red colour. - style
The selection style of options:
pmStyleClassic
The options are presented as a traditional menu. They are numbered (done by the PopupMenu() procedure), an input field is displayed where the user must enter the number of the requested option.
pmStyleCursor
The options are presented as a list. The user must selected by moving the cursor to the requested option, and press the [ENTER] key.
pmStylePushBtn
The options are presented as a list of push buttons. The user must use either the mouse or the [TAB] and [BACK-TAB] keys to move to the requested option and then either use the mouse to select or by pressing the [ENTER] key. If the terminal supports GUI, the push buttons are displayed as GUI push buttons. If the terminal does not support GUI, the push buttons are displayed as text buttons. - remove_menu
If set to *On the menu is removed from the screen before the procedure returns.
If set to *Off the menu is left on the screen and it is caller’s responsibility to re-draw the screen. - title
A text to display as the title of the window showing the popup menu. Can be a max of 70 characters.
If you do not want a title to be displayed, then just the field to ” (empty character field). - header
The header is displayed as the first line in the popup menu window. Can be a max of 70 characters.
If you do not want a title to be displayed, then just the field to ” (empty character field). - footer
The footer is displayed under the list of options. Can be a max of 70 characters. A blank line is added between the list of options and the footer.
If you do not want a footer to be displayed, then just the field to ” (empty character field). - fkey_text
The fkey_text is displayed under the footer. It is displayed in blue colour and it can be a max of 70 characters. If no footer then the fkey_text is displayed under the list op options.
If you do not want a fkey_text to be displayed, then just the field to ” (empty character field). - options(15)
The options that is displayed in the popup menu. It is a character array of 15 elements, of 70 characters.
At least one option must be filled in the array. The array must be filled from the beginning and it must be filled without ‘holes’. When presented, the options are considered to terminate at the first blank/empty element.
PopupMenu() returns an integer:
- A value greater than *Zeros
The number of the option that the user selected. - pmResultNoSelection
The user pressed F3 or F12 to cancel the menu. - pmResultNoOptions
There are no options in the Options array. - pmResultBorderInvalid
The value for the border is invalid. - pmResultStyleInvalid
The value for the style is invalid. - pmResultColInvalid
The value for the column is invalid. - pmResultRowInvalid
The value for the row is invalid. - pmResultLocationInvalid
The value for the location is invalid. - pmResultAPIError
One of the APIs returned an error when called.
A big thanks to to Scott C. Klement for creating the original QSNAPI_H source member and releasing it.
Have fun 🙂
Listing 1, member POPMNU_PR, type RPGLE:
**Free
//
// PopMnu_Pr
// ---------
// Prototype for function PopupMenu() that shows a popup menu and lets
// the user select an option.
//
// Jesper Wachs, Version 1, December 2018.
//
// The source member are delivered 'as is'.
//
// Neither Jesper Wachs nor anyone else who has been involved in
// the creation, production or delivery of this product shall be
// liable for any direct, indirect, consequential or incidental
// damages (including damages for loss of business profits,
// business interruption, loss of business information, and the
// like) arising out of the use or inability to use such product
// even if Jesper Wachs has been advised of the possibility of
// such damages.
//
Dcl-PR PopupMenu Packed(3:0);
iLocation Packed(3:0) Const;
iRow Packed(3:0) Const;
iCol Packed(3:0) Const;
iBorder Packed(3:0) Const;
iStyle Packed(3:0) Const;
iRmvMenu Ind Const;
iTitle Char(70) Const;
iHeader Char(70) Const;
iFooter Char(70) Const;
iFKeyText Char(70) Const;
iOptions Char(70) Const Dim(15);
End-PR;
//
// The procedure PopupMenu must be called with these parameters:
//
// PopupMenu(
// location: Controls where the popup menu is to be
// displayed. See constants for details.
// row: If location is pmLocationRowCol then set this
// to the row (1 - 27). Otherwise, set to zero.
// col: If location is pmLocationRowCol then set this
// to the col (1 - 132).Otherwise, set to zero.
// border: The type of border to display around the
// popup menu.
// style: The style of the menu.
// pmStyleClassic will display a option number
// in front of the option. An entry field to enter
// the option number is displayed. Selection is
// done by entering the number and pressing the
// ENTER key.
// pmStyleCursor will display the options centered
// in the window. Selection is done by moving the
// cursor to the option in question and pressing
// the ENTER key.
// pmStyleBtn will display each option as a push
// button either in GUI or Text mode, depending
// on the terminal (emulator) capabilities.
// Selection is done by clicking on the push
// button in question with the mouse or using the
// arrow keys and pressing the ENTER key.
// rmvmenu: Set to *On to remove the popup menu after
// the user have made a selection. Set to *Off
// to leave the popup menu on screen. This will
// require that caller redraw the screen to
// remove the popup menu.
// title: The title of the popup menu. Is displayed in
// top of the border of the popup menu. Can be
// set to *blanks.
// header: The header for the menu options. Is displayed
// at the top of the popup window above the
// menu items. Can be set to *blanks.
// footer: The footer for the menu options. Is displayed
// just below the menu options. Can be set to
// *blanks.
// fkeytext: Aline to be display with F-keys. The line will
// be displayed in blue colour.
// options: An array with 15 options. The options must be
// filled from the begining of the array.
// Not used options must be set to *blanks.
// )
//
// Constants
// ---------
//
// pmLocation*
// -----------
// The place to display the menu.
//
// pmLocationCenter:
//
Dcl-C pmLocationCenter Const(1);
//
// pmLocationCursor:
//
Dcl-C pmLocationCursor Const(2);
//
// pmLocationRowCol:
//
Dcl-C pmLocationRowCol Const(3);
//
// pmStyle*
// --------
// The style of the menu.
//
// pmStyleClassic:
//
Dcl-C pmStyleClassic Const(1);
//
// pmStyleCursor:
//
Dcl-C pmStyleCursor Const(2);
//
// pmStylePushBtn:
//
Dcl-C pmStylePushBtn Const(3);
//
// pmBorder*
// ---------
// The border of the menu.
//
// pmBorderDefault:
//
Dcl-C pmBorderDefault Const(1);
//
// pmBorderReverseBlue:
//
Dcl-C pmBorderReverseBlue Const(2);
//
// pmBorderReverseGreen:
//
Dcl-C pmBorderReverseGreen Const(3);
//
// pmBorderAlert:
//
Dcl-C pmBorderAlert Const(4);
//
// pmResult*
// ---------
// pmResultAPIError:
//
Dcl-C pmResultAPIError Const(-7);
//
// pmResultLocationInvalid:
//
Dcl-C pmResultLocationInvalid Const(-6);
//
// pmResultRowInvalid:
//
Dcl-C pmResultRowInvalid Const(-5);
//
// pmResultColInvalid:
//
Dcl-C pmResultColInvalid Const(-4);
//
// pmResultStyleInvalid:
//
Dcl-C pmResultStyleInvalid Const(-3);
//
// pmResultBorderInvalid:
//
Dcl-C pmResultBorderInvalid Const(-2);
//
// pmResultNoOptions:
//
Dcl-C pmResultNoOptions Const(-1);
//
// pmResultNoSelection:
//
Dcl-C pmResultNoSelection Const(0);
Listing 2, member POPMNU, type RPGLE:
**Free
Ctl-Opt NoMain BndDir('QC2LE');
//
// PopMnu
// ------
// Function to display a popup menu where the user can select an
// option. The option number is then returned to caller.
//
// Jesper Wachs, Version 1, December 2018.
//
// The source member are delivered 'as is'.
//
// Neither Jesper Wachs nor anyone else who has been involved in
// the creation, production or delivery of this software shall be
// liable for any direct, indirect, consequential or incidental
// damages (including damages for loss of business profits,
// business interruption, loss of business information, and the
// like) arising out of the use or inability to use such product
// even if Jesper Wachs has been advised of the possibility of
// such damages.
//
// Copymember for exported functions.
// ----------------------------------
/copy qrpglesrc,popmnu_pr
//
// Copymember(s) for imported functions.
// -------------------------------------
/copy qrpglesrc,qsnapiw_h
//
// Prototypes for local functions.
// -------------------------------
Dcl-PR CalcMenuSize Packed(3:0);
iStyle Packed(3:0) Const;
iGUISupport Ind Const;
iTitle Char(74) Const;
iHeader Char(74) Const;
iFooter Char(74) Const;
iFKeysText Char(74) Const;
iOptions Char(74) Const Dim(15);
oMaxLen Packed(3:0);
oNbrElm Packed(3:0);
oMaxElmLen Packed(3:0);
oNbrLin Packed(3:0);
End-PR;
Dcl-PR CreatePopupWindow Int(10:0);
iRow Packed(3:0) Const;
iCol Packed(3:0) Const;
iNbrRow Packed(3:0) Const;
iNbrCol Packed(3:0) Const;
iNbrElm Packed(3:0) Const;
iBorder Packed(3:0) Const;
iStyle Packed(3:0) Const;
iTitle VarChar(70) Value;
iHeader VarChar(70) Value;
iFooter VarChar(70) Value;
iFKeyText VarChar(70) Value;
ohCmdBuf Int(10:0);
ohInpBuf Int(10:0);
ohWin Int(10:0);
End-PR;
Dcl-PR GetScreenSize;
oRows Packed(3:0);
oCols Packed(3:0);
End-PR;
Dcl-PR OptionsAsClassic Int(10:0);
ihCmdBuf Int(10:0) Const;
ihInpBuf Int(10:0) Const;
ihWin Int(10:0) Const;
iNbrElm Packed(3:0) Const;
iOptions Char(70) Const Dim(15);
iHdrLen Packed(3:0) Const;
iFtrLen Packed(3:0) Const;
oSltOpt Packed(3:0);
End-PR;
Dcl-PR OptionsAsCursor Int(10:0);
ihCmdBuf Int(10:0) Const;
ihInpBuf Int(10:0) Const;
ihWin Int(10:0) Const;
iNbrElm Packed(3:0) Const;
iOptions Char(70) Const Dim(15);
iHdrLen Packed(3:0) Const;
iFtrLen Packed(3:0) Const;
oSltOpt Packed(3:0);
End-PR;
Dcl-PR OptionsAsPushBtnChar Int(10:0);
ihCmdBuf Int(10:0) Const;
ihInpBuf Int(10:0) Const;
ihWin Int(10:0) Const;
iNbrElm Packed(3:0) Const;
iOptions Char(70) Const Dim(15);
iHdrLen Packed(3:0) Const;
iMaxLen Packed(3:0) Const;
iMaxElmLen Packed(3:0) Const;
iRow Packed(3:0) Const;
oSltOpt Packed(3:0);
End-PR;
Dcl-PR OptionsAsPushBtnGUI Int(10:0);
ihCmdBuf Int(10:0) Const;
ihInpBuf Int(10:0) Const;
ihWin Int(10:0) Const;
iNbrElm Packed(3:0) Const;
iOptions Char(70) Const Dim(15);
iHdrLen Packed(3:0) Const;
iMaxLen Packed(3:0) Const;
iMaxElmLen Packed(3:0) Const;
iRow Packed(3:0) Const;
oSltOpt Packed(3:0);
End-PR;
Dcl-PR ValidateParms Packed(3:0);
iLocation Packed(3:0) Const;
iRow Packed(3:0) Const;
iCol Packed(3:0) Const;
iBorder Packed(3:0) Const;
iStyle Packed(3:0) Const;
iOptions Char(70) Const Dim(15);
End-PR;
//
// Exported funtions.
// ------------------
// PopupMenu
// ---------
//
Dcl-Proc PopupMenu Export;
Dcl-PI PopupMenu Packed(3:0);
iLocation Packed(3:0) Const;
iRow Packed(3:0) Const;
iCol Packed(3:0) Const;
iBorder Packed(3:0) Const;
iStyle Packed(3:0) Const;
iRmvMenu Ind Const;
iTitle Char(70) Const;
iHeader Char(70) Const;
iFooter Char(70) Const;
iFKeyText Char(70) Const;
iOptions Char(70) Const Dim(15);
End-PI;
// Local work fields.
Dcl-S Row Packed(3:0);
Dcl-S Col Packed(3:0);
Dcl-S CsrCol Int(10:0);
Dcl-S CsrRow Int(10:0);
Dcl-S GUISupport Ind;
Dcl-S hCmdBuf Int(10:0);
Dcl-S hInpBuf Int(10:0);
Dcl-S hWin Int(10:0);
Dcl-S SltOpt Packed(3:0);
Dcl-S RowMax Packed(3:0);
Dcl-S ColMax Packed(3:0);
Dcl-S MaxElmLen Packed(3:0);
Dcl-S MaxLen Packed(3:0);
Dcl-S NbrElm Packed(3:0);
Dcl-S NbrLin Packed(3:0);
Dcl-S RtnCode Packed(3:0);
Dcl-S Res Int(10:0);
// Validate input parms
RtnCode = ValidateParms(iLocation:
iRow:
iCol:
iBorder:
iStyle:
iOptions);
If RtnCode = *Zeros;
// Check if GUI is supported
CallP QsnQry5250(QsnQ5250: %Size(QsnQ5250): *Omit);
If %BitAnd(QsnQ5wscb5: x'02') = x'02';
GUISupport = *On;
Else;
GuiSupport = *Off;
EndIf;
// Based on input values, calculate the size of the popup menu.
RtnCode = CalcMenuSize(iStyle:
GUISupport:
iTitle:
iHeader:
iFooter:
iFKeyText:
iOptions:
MaxLen:
NbrElm:
MaxElmLen:
NbrLin);
If RtnCode = *Zeros;
// This section sets the row and column of where to display the
// popup menu.
CallP GetScreenSize(RowMax: ColMax);
// Adjust the popup menu based on the location to display it.
Select;
// Display the popup menu at Row, Col for the top left corner.
When iLocation = pmLocationRowCol;
Row = iRow;
Col = iCol;
// Display the popup menu at the Row, Col where the cursor is
// currently positioned.
When iLocation = pmLocationCursor;
// Disable Window Mode
RtnCode = QsnSetEnvWinMod('0':
*Omit:
*Omit:
*Omit:
*Omit:
*Omit);
// Get Cursor Address
If RtnCode = *Zeros;
RtnCode = QsnGetCsrAdr(CsrRow:
CsrCol:
*Omit:
*Omit);
Row = CsrRow + 1;
Col = CsrCol;
EndIf;
If RtnCode <> *Zeros;
RtnCode = pmResultAPIError;
EndIf;
// Display the popup menu at the center of the screen, taking
// into consideration if the screen is in 24x80 or 27x132 mode.
When iLocation = pmLocationCenter;
Row = (RowMax - NbrLin - 0) / 2;
Col = (ColMax - MaxLen - 3) / 2;
EndSl;
If RtnCode = *Zeros;
If Row + NbrLin + 1 > RowMax;
Row = RowMax - 1 - NbrLin;
EndIf;
If Col + MaxLen + 5 > ColMax;
Col = ColMax - 5 - MaxLen;
EndIf;
// Build the menu window.
RtnCode = CreatePopupWindow(Row:
Col:
NbrLin:
MaxLen:
NbrElm:
iBorder:
iStyle:
iTitle:
iHeader:
iFooter:
iFKeyText:
hCmdBuf:
hInpBuf:
hWin);
If RtnCode = *Zeros;
// This section makes adjustmens based on the style to use for
// the menu.
// Add options depending on the menu type
Select;
// Classic style: Menu options and a field to enter the sele
When iStyle = pmStyleClassic;
RtnCode = OptionsAsClassic(hCmdBuf:
hInpBuf:
hWin:
NbrElm:
iOptions:
%Len(%TrimR(iHeader)):
%Len(%TrimR(iFooter)):
SltOpt
);
If RtnCode = *Zeros;
RtnCode = SltOpt;
EndIf;
// Cursor style: User must move the cursor to the selection
// ENTER.
When iStyle = pmStyleCursor;
RtnCode = OptionsAsCursor(hCmdBuf:
hInpBuf:
hWin:
NbrElm:
iOptions:
%Len(%TrimR(iHeader)):
Row:
SltOpt
);
If RtnCode = *Zeros;
RtnCode = SltOpt;
EndIf;
// Push Button style: Each menu item is a push button. The u
// click on the button to select the item
When iStyle = pmStylePushBtn;
If GUISupport = *Off;
RtnCode = OptionsAsPushBtnChar(hCmdBuf:
hInpBuf:
hWin:
NbrElm:
iOptions:
%Len(%TrimR(iHeader)):
MaxLen:
MaxElmLen:
Row:
SltOpt
);
If RtnCode = *Zeros;
RtnCode = SltOpt;
EndIf;
Else;
// Display char push buttons
RtnCode = OptionsAsPushBtnGUI(hCmdBuf:
hInpBuf:
hWin:
NbrElm:
iOptions:
%Len(%TrimR(iHeader)):
MaxLen:
MaxElmLen:
Row:
SltOpt
);
EndIf;
If RtnCode = *Zeros;
RtnCode = SltOpt;
EndIf;
EndSl;
EndIf;
EndIf;
EndIf;
// Delete Command Buffer
If hCmdBuf <> *Zeros;
CallP QsnDltBuf(hCmdBuf: *Omit);
EndIf;
// Delete Input Buffer
If hInpBuf <> *Zeros;
CallP QsnDltBuf(hInpBuf: *Omit);
EndIf;
// End Window
If hWin <> *Zeros;
CallP QsnEndWin(hWin: iRmvMenu: *Omit);
EndIf;
// Delete environment
If hWin <> *Zeros;
CallP QsnDltEnv(hWin: *Omit);
EndIf;
EndIf;
Return RtnCode;
End-Proc PopupMenu;
//
// Internal functions.
// -------------------
// CalcMenuSize
// ------------
// Calculates the height and width of the popup menu, based on the
// number of items and the width of each item.
Dcl-Proc CalcMenuSize;
Dcl-PI CalcMenuSize Packed(3:0);
iStyle Packed(3:0) Const;
iGUISupport Ind Const;
Title Char(74) Const;
Header Char(74) Const;
Footer Char(74) Const;
FKeyText Char(74) Const;
Options Char(74) Const Dim(15);
MaxLen Packed(3:0);
NbrElm Packed(3:0);
oMaxElmLen Packed(3:0);
NbrLin Packed(3:0);
End-PI;
// Local work fields.
Dcl-S ElmLen Packed(3:0);
Dcl-S Idx Packed(3:0);
Dcl-S MaxOptLen Packed(3:0);
NbrLin = *Zeros;
MaxLen = %Len(%TrimR(Title));
// If there is a Header text, then make room for it.
ElmLen = %Len(%TrimR(Header));
If ElmLen > *Zeros;
NbrLin = NbrLin + 2;
EndIf;
If ElmLen > MaxLen;
MaxLen = ElmLen;
EndIf;
// If there is a Footer text, then make room for it.
ElmLen = %Len(%TrimR(Footer));
If ElmLen > *Zeros;
NbrLin = NbrLin + 1;
If ElmLen > MaxLen;
MaxLen = ElmLen;
EndIf;
EndIf;
// If there is a FKey text, then make room for it.
ElmLen = %Len(%TrimR(FKeyText));
If ElmLen > *Zeros;
NbrLin = NbrLin + 1;
EndIf;
If ElmLen > MaxLen;
MaxLen = ElmLen;
EndIf;
NbrElm = %Elem(Options);
MaxOptLen = *Zeros;
// Find longest element
For Idx = 1 to %Elem(Options);
If Options(Idx) = *Blanks;
NbrElm = Idx - 1;
Leave;
EndIf;
ElmLen = %Len(%TrimR(Options(Idx)));
If ElmLen > MaxOptLen;
MaxOptLen = ElmLen;
EndIf;
EndFor;
If NbrElm > *Zeros;
oMaxElmLen = MaxOptLen;
// Make adjustments based on the style.
Select;
// Classic style: If more than 9 items, make sure they are aligned.
When iStyle = pmStyleClassic;
NbrLin = NbrLin + 2;
If NbrElm >= 10;
MaxOptLen = MaxOptLen + 4;
Else;
MaxOptLen = MaxOptLen + 3;
EndIf;
If MaxOptLen > MaxLen;
MaxLen = MaxOptLen;
EndIf;
// Cursor style: Make more space.
When iStyle = pmStyleCursor;
NbrLin = NbrLin + 1;
If MaxOptLen > MaxLen;
MaxLen = MaxOptLen;
EndIf;
// Push Button style: Make more space and make menu wide enough.
When iStyle = pmStylePushBtn;
NbrLin = NbrLin + 1;
If iGUISupport = *Off;
MaxOptLen = MaxOptLen + 2;
Else;
MaxOptLen = MaxOptLen + 3;
EndIf;
If MaxOptLen > MaxLen;
MaxLen = MaxOptLen;
EndIf;
EndSl;
// Make sure height and width are within limits.
NbrLin = NbrLin + NbrElm;
If NbrLin > 20;
NbrLin = 20;
EndIf;
If MaxLen > 74;
MaxLen = 74;
EndIf;
Return *Zeros;
Else;
Return pmResultNoOptions;
EndIf;
End-Proc CalcMenuSize;
//
// CreatePopupWindow
// -----------------
// Creates the popup window by filling the required commands into
// the command buffer.
Dcl-Proc CreatePopupWindow;
Dcl-PI CreatePopupWindow Int(10:0);
iRow Packed(3:0) Const;
iCol Packed(3:0) Const;
iNbrRow Packed(3:0) Const;
iNbrCol Packed(3:0) Const;
iNbrElm Packed(3:0) Const;
iBorder Packed(3:0) Const;
iStyle Packed(3:0) Const;
iTitle VarChar(70) Value;
iHeader VarChar(70) Value;
iFooter VarChar(70) Value;
iFKeyText VarChar(70) Value;
ohCmdBuf Int(10:0);
ohInpBuf Int(10:0);
ohWin Int(10:0);
End-PI;
// Local work fields.
Dcl-S Res Int(10:0);
Dcl-S StartCol Int(10:0);
Dcl-S StartLin Int(10:0);
Dcl-S WinDLen Int(10:0);
iTitle = %Trim(iTitle);
iHeader = %Trim(iHeader);
iFooter = %Trim(iFooter);
iFKeyText = %Trim(iFKeyText);
// Default Windows Description
WinDLen = %Size(QsnWinD);
QsnWinD = *Allx'00';
Res = QsnInzWinD(QsnWinD:
WinDLen:
*Omit);
If Res >= *Zeros;
// Create command buffer
ohCmdBuf = QsnCrtCmdBuf(300:
20:
0:
*Omit:
*Omit);
// Create input buffer
ohInpBuf = QsnCrtInpBuf(200:
50:
0:
*Omit:
*Omit);
// Clear buffers
Res = QsnClrBuf(ohCmdBuf:
*Omit);
If Res >= *Zeros;
Res = QsnClrBuf(ohInpBuf:
*Omit);
// Create a window
// Set creation parms.
QsnWTopR = iRow;
QsnWLeftC = iCol;
QsnWNumR = iNbrRow;
QsnWNumC = iNbrCol;
QsnWMinR = iNbrRow;
QsnWMinC = iNbrCol;
QsnWMaxR = iNbrRow;
QsnWMaxC = iNbrCol;
// Set attributes and colours based on border type.
Select;
// Default border
When iBorder = pmBorderDefault;
QsnWTAtrC = QSN_SA_BLU_RI;
QsnWTAtrM = QSN_SA_RI;
// Reverse blue border
When iBorder = pmBorderReverseBlue;
QsnWGUI = *Off;
QsnWULCh = *Blank;
QsnWTopCh= *Blank;
QsnWURCh = *Blank;
QsnWLCh = *Blank;
QsnWRCh = *Blank;
QsnWLLCh = *Blank;
QsnWBotCh = *Blank;
QsnWLRCh = *Blank;
QsnWAtrC2 = QSN_SA_BLU_RI;
QsnWTAtrC = x'00';
QsnWAtrM2 = QSN_SA_RI;
QsnWTAtrM = x'00';
// Reserve green broder
When iBorder = pmBorderReverseGreen;
QsnWGUI = *Off;
QsnWULCh = *Blank;
QsnWTopCh= *Blank;
QsnWURCh = *Blank;
QsnWLCh = *Blank;
QsnWRCh = *Blank;
QsnWLLCh = *Blank;
QsnWBotCh = *Blank;
QsnWLRCh = *Blank;
QsnWAtrC2 = QSN_SA_GRN_RI;
QsnWTAtrC = x'00';
QsnWAtrM2 = QSN_SA_RI;
QsnWTAtrM = x'00';
// Alert border
When iBorder = pmBorderAlert;
QsnWGUI = *Off;
QsnWULCh = *Blank;
QsnWTopCh= *Blank;
QsnWURCh = *Blank;
QsnWLCh = *Blank;
QsnWRCh = *Blank;
QsnWLLCh = *Blank;
QsnWBotCh = *Blank;
QsnWLRCh = *Blank;
QsnWAtrC2 = QSN_SA_RED_RI;
QsnWTAtrC = x'00';
QsnWAtrM2 = QSN_SA_RI;
QsnWTAtrM = x'00';
EndSl;
If iTitle > *Blanks;
QsnWTtlO = 76;
QsnWTtl = iTitle;
QsnWTtlL = %Len(iTitle);
EndIf;
ohWin = QsnCrtWin(QsnWinD:
WinDLen:
*Omit:
*Omit:
*Omit:
*Omit:
*Omit:
*Omit:
*Omit);
// Set Current window
Res = QsnSetCurWin(ohWin:
*Omit);
// Set Environment Window Mode
QsnEWAtrC = '1';
QsnEWULR = QsnWTopR;
QsnEWULC = QsnWLeftC;
QsnEWNumR = QsnWNumR;
QsnEWNumC = QsnWNumC + 2;
Res = QsnSetEnvWinMod('1':
*Omit:
QsnEnvWM:
%Size(QsnEnvWM):
*Omit:
*Omit);
EndIf;
EndIf;
If Res = *Zeros;
// Starting point for constants
StartLin = *Zeros;
// Write Header text
If iHeader > *Blanks;
StartLin = StartLin + 1;
StartCol = ((iNbrCol - %Len(iHeader))
/ 2) + 2;
Res = QsnWrtDta(iHeader:
%Len(iHeader):
*Omit:
StartLin:
StartCol:
QSN_SA_HI:
*Omit:
QSN_SA_HI:
*Omit:
ohCmdBuf:
*Omit:
*Omit);
StartLin = StartLin + 1;
EndIf;
If Res = *Zeros;
// Adjust for number of element in menu
StartLin = StartLin + iNbrElm + 1;
// Write footer
If iFooter > *Blanks;
StartLin = StartLin + 1;
Res = QsnWrtDta(iFooter:
%Len(iFooter):
*Omit:
StartLin:
2:
QSN_SA_NORM:
*Omit:
QSN_SA_NORM:
*Omit:
ohCmdBuf:
*Omit:
*Omit);
If iStyle = pmStyleClassic;
StartLin = StartLin + 1;
EndIf;
EndIf;
If Res = *Zeros;
// Write F-Key text
If iFKeyText > *Blanks;
StartLin = StartLin + 1;
Res = QsnWrtDta(iFKeyText:
%Len(iFKeyText):
*Omit:
StartLin:
2:
QSN_SA_NORM:
*Omit:
QSN_SA_BLU:
*Omit:
ohCmdBuf:
*Omit:
*Omit);
EndIf;
EndIf;
EndIf;
EndIf;
If Res <> *Zeros;
Res = pmResultAPIError;
EndIf;
Return Res;
End-Proc CreatePopupWindow;
//
// GetScreenSize
// ----------------
// Returns the size of the screen.
Dcl-Proc GetScreenSize;
Dcl-PI GetScreenSize;
oRows Packed(3:0);
oCols Packed(3:0);
End-PI;
Dcl-C C24ROWS Const(24);
Dcl-C C80COLS Const(80);
Dcl-C C27ROWS Const(27);
Dcl-C C132COLS Const(132);
Dcl-C C24X80MODE Const('3');
Dcl-C C27X132MODE Const('4');
// Local work fields.
Dcl-S wDspMode Char(1);
CallP QsnRtvMod(wDspMode:
*Omit:
*Omit);
Select;
When wDspMode = c24x80Mode;
oRows = c24Rows;
oCols = c80Cols;
When wDspMode = c27x132Mode;
oRows = c27Rows;
oCols = c132Cols;
// This should not be possible.
Other;
oRows = -1;
oCols = -1;
EndSl;
Return;
End-Proc GetScreenSize;
//
// OptionsAsClassic
// ----------------
// Build the menu items as classic menu options and add an entry field.
Dcl-Proc OptionsAsClassic;
Dcl-PI OptionsAsClassic Int(10:0);
ihCmdBuf Int(10:0) Const;
ihInpBuf Int(10:0) Const;
ihWin Int(10:0) Const;
iNbrElm Packed(3:0) Const;
iOptions Char(70) Const Dim(15);
iHdrLen Packed(3:0) Const;
iFtrLen Packed(3:0) Const;
oSltOpt Packed(3:0);
End-PI;
// Local work fields.
Dcl-S Answer Char(2);
Dcl-S FldLen Packed(1:0);
Dcl-S Idx Packed(3:0);
Dcl-S InpFldLin Packed(3:0);
Dcl-S Len Packed(9:0);
Dcl-S Offset Packed(3:0);
Dcl-S OneChar Char(1);
Dcl-S pInputData Pointer;
Dcl-S Res Int(10:0);
Dcl-S TempString VarChar(70);
Dcl-S TwoDigits Zoned(2:0);
Dcl-DS InputData Based(pInputData);
Row Uns(3:0);
Col Uns(3:0);
AID Char(1);
Field Char(500);
End-DS;
// DS for converting char to numeric
Dcl-DS *N;
TheChar Char(1) Pos(1);
TheNum Zoned(1:0) Pos(1);
End-DS;
oSltOpt = *Zeros;
// Dertermine where to start the list of items.
If iHdrLen > *Zeros;
Offset = 2;
InpFldLin = 4;
Else;
Offset = *Zeros;
InpFldLin = 2;
EndIf;
// Adjust if a footer is entered.
If iFtrLen > *Zeros;
InpFldLin = InpFldLin + 1;
EndIf;
InpFldLin = InpFldLin + iNbrElm;
// Write each item, preceeded by the item nbr, to the window.
For Idx = 1 to iNbrElm;
TwoDigits = Idx;
TempString = %EditC(TwoDigits: '4');
If iNbrElm < 10;
TempString = %TrimL(TempString);
EndIf;
TempString = TempString + '. ' +
%Trim(iOptions(Idx));
// Write option to buffer
Res = QsnWrtDta(TempString:
%Len(TempString):
*Omit:
Idx + Offset:
2:
QSN_SA_NORM:
*Omit:
QSN_SA_NORM:
*Omit:
ihCmdBuf:
*Omit:
*Omit);
EndFor;
// Add Input field for selection
Res = QsnWrtDta('===>':
4:
*Omit:
InpFldLin:
2:
*Omit:
*Omit:
*Omit:
*Omit:
ihCmdBuf:
*Omit:
*Omit);
// Loop until valid input
DoU AID = Qsn_Enter Or
AID = Qsn_F3 Or
AID = Qsn_F12;
// Set Field
If iNbrElm < 10;
FldLen = 1;
Else;
FldLen = 2;
EndIf;
Res = QsnSetFld(1:
FldLen:
InpFldLin:
7:
QSN_FFW_NUM_ONLY +
QSN_FFW_MDT:
*Omit:
0:
QSN_SA_UL:
QSN_SA_GRN_UL:
ihCmdBuf:
*Omit:
*Omit);
// Read Input
Res = QsnReadInp(QSN_CC1_NULL:
QSN_CC2_NO_IC:
*Omit:
*Omit:
ihCmdBuf:
*Omit:
*Omit);
// Put and Get Buffer
Res = QsnPutGetBuf(ihCmdBuf:
ihInpBuf:
*Omit:
*Omit);
// Retrieve current window
Res = QsnRtvCurWin(ihWin:
*Omit);
If Res > *Zeros;
Res = *Zeros;
EndIf;
// Get input data
pInputData = QsnRtvDta(ihInpBuf:
*Omit:
*Omit);
Select;
// ENTER key pressed.
When AID = Qsn_Enter;
// Extract field data
Len = QsnRtvDtaLen(ihInpBuf:
*Omit:
*Omit) -
%Size(Row) -
%Size(Col) -
%Size(AId);
If Len > *Zeros;
Answer = %Trim(%SubSt(Field: 1: Len));
// Scrup data out
OneChar = %Subst(Answer: 1: 1);
If OneChar >= '0' And
OneChar <= '9';
TheChar = OneChar;
oSltOpt = TheNum;
EndIf;
OneChar = %Subst(Answer: 2: 1);
If OneChar >= '0' And
OneChar <= '9';
oSltOpt = oSltOpt * 10;
TheChar = OneChar;
oSltOpt = oSltOpt + TheNum;
EndIf;
If oSltOpt = *Zeros Or
oSltOpt > iNbrElm;
AID = *Allx'00';
// Clear buffers
Res = QsnClrBuf(ihCmdBuf:
*Omit);
If Res >= *Zeros;
Res = QsnClrBuf(ihInpBuf:
*Omit);
EndIf;
EndIf;
EndIf;
// F3 or F12 key pressed.
When AID = Qsn_F3 Or AID = Qsn_F12;
// Do not do anything, as this will terminate the loop.
Other;
AID = *Allx'00';
// Clear buffers
Res = QsnClrBuf(ihCmdBuf:
*Omit);
If Res >= *Zeros;
Res = QsnClrBuf(ihInpBuf:
*Omit);
EndIf;
EndSl;
EndDo;
If Res = -1;
Res = pmResultAPIError;
EndIf;
Return Res;
End-Proc OptionsAsClassic;
//
// OptionsAsCursor
// ---------------
// Build the menu items for selection by moving the cursor.
Dcl-Proc OptionsAsCursor;
Dcl-PI OptionsAsCursor Int(10:0);
ihCmdBuf Int(10:0) Const;
ihInpBuf Int(10:0) Const;
ihWin Int(10:0) Const;
iNbrElm Packed(3:0) Const;
iOptions Char(70) Const Dim(15);
iHdrLen Packed(3:0) Const;
iFtrLen Packed(3:0) Const;
oSltOpt Packed(3:0);
End-PI;
// Local work fields.
Dcl-S Idx Packed(3:0);
Dcl-S Offset Packed(3:0);
Dcl-S pInputData Pointer;
Dcl-S Res Int(10:0);
Dcl-S TempString VarChar(70);
Dcl-DS InputData Based(pInputData);
Row Uns(3:0);
Col Uns(3:0);
AID Char(1);
Field Char(500);
End-DS;
oSltOpt = *Zeros;
If iHdrLen > *Zeros;
Offset = 2;
Else;
Offset = *Zeros;
EndIf;
// Write each option to the window.
For Idx = 1 to iNbrElm;
TempString = %Trim(iOptions(Idx));
// Write option to buffer
Res = QsnWrtDta(TempString:
%Len(TempString):
*Omit:
Idx + Offset:
2:
QSN_SA_NORM:
*Omit:
QSN_SA_NORM:
*Omit:
ihCmdBuf:
*Omit:
*Omit);
EndFor;
// Loop until valid input
DoU AID = Qsn_Enter Or
AID = Qsn_F3 Or
AID = Qsn_F12;
// Set the cursor position
Res = QsnSetCsrAdr(*Omit:
1 + Offset:
2:
ihCmdBuf:
*Omit:
*Omit);
// Read Input
Res = QsnReadInp(QSN_CC1_NULL:
QSN_CC2_NO_IC:
*Omit:
*Omit:
ihCmdBuf:
*Omit:
*Omit);
// Put and Get Buffer
Res = QsnPutGetBuf(ihCmdBuf:
ihInpBuf:
*Omit:
*Omit);
// Retrieve current window
Res = QsnRtvCurWin(ihWin:
*Omit);
If Res > *Zeros;
Res = *Zeros;
EndIf;
// Get input data
pInputData = QsnRtvDta(ihInpBuf:
*Omit:
*Omit);
Select;
// ENTER key pressed.
When AID = Qsn_Enter;
// Calculate the selected line
oSltOpt = Row - iFtrLen - Offset;
If oSltOpt < 1 Or
oSltOpt > iNbrElm;
AID = *Allx'00';
// Clear buffers
Res = QsnClrBuf(ihCmdBuf:
*Omit);
If Res >= *Zeros;
Res = QsnClrBuf(ihInpBuf:
*Omit);
EndIf;
EndIf;
// F3 or F12 key pressed.
When AID = Qsn_F3 Or AID = Qsn_F12;
// Do not do anything, as this will terminate the loop.
Other;
AID = *Allx'00';
// Clear buffers
Res = QsnClrBuf(ihCmdBuf:
*Omit);
If Res >= *Zeros;
Res = QsnClrBuf(ihInpBuf:
*Omit);
EndIf;
EndSl;
EndDo;
If Res = -1;
Res = pmResultAPIError;
EndIf;
Return Res;
End-Proc OptionsAsCursor;
//
// OptionsAsPushBtnChar
// --------------------
// Build the menu items as push buttons, in char format for non-GUI
// terminals.
Dcl-Proc OptionsAsPushBtnChar;
Dcl-PI OptionsAsPushBtnChar Int(10:0);
ihCmdBuf Int(10:0) Const;
ihInpBuf Int(10:0) Const;
ihWin Int(10:0) Const;
iNbrElm Packed(3:0) Const;
iOptions Char(70) Const Dim(15);
iHdrLen Packed(3:0) Const;
iMaxLen Packed(3:0) Const;
iMaxElmLen Packed(3:0) Const;
iRow Packed(3:0) Const;
oSltOpt Packed(3:0);
End-PI;
// Local work fields.
Dcl-S FieldXPos Packed(3:0);
Dcl-S Idx Packed(3:0);
Dcl-S Offset Packed(3:0);
Dcl-S PadSpaces Packed(3:0);
Dcl-S pInputData Pointer;
Dcl-S Res Int(10:0);
Dcl-S Spaces Char(75) Inz(*Blanks);
Dcl-S TempString VarChar(70);
Dcl-DS InputData Based(pInputData);
Row Uns(3:0);
Col Uns(3:0);
AID Char(1);
Field Char(500);
End-DS;
oSltOpt = *Zeros;
// Calculate pushbutton start pos
FieldXPos = (iMaxLen - iMaxElmLen) / 2;
FieldXPos = FieldXPos + 2;
// Compensate starting line if no Header
If iHdrLen > *Zeros;
Offset = 2;
Else;
Offset = *Zeros;
EndIf;
// Loop though the items and draw them
For Idx = 1 to iNbrElm;
TempString = '<' + %Trim(iOptions(Idx));
PadSpaces = iMaxElmLen -
%Len(TempString) + 1;
If PadSpaces > *Zeros;
TempString = TempString + %SubSt(
Spaces:
1:
PadSpaces);
EndIf;
TempString = TempString + '>';
// Input field to allow for cursor to shift between pushbuttons
Res = QsnSetFld(Idx:
1:
Idx + Offset:
FieldXPos:
QSN_FFW_IO:
*Omit:
0:
QSN_SA_NORM:
*Omit:
ihCmdBuf:
*Omit:
*Omit);
// Write option to buffer
Res = QsnWrtDta(TempString:
%Len(TempString):
*Omit:
Idx + Offset:
FieldXPos - 1:
QSN_SA_NORM:
*Omit:
QSN_SA_NORM:
*Omit:
ihCmdBuf:
*Omit:
*Omit);
EndFor;
// Set the cursor position
Res = QsnSetCsrAdr(1:
*Omit:
*Omit:
ihCmdBuf:
*Omit:
*Omit);
// Loop until valid input
DoU AID = Qsn_Enter Or
AID = Qsn_F3 Or
AID = Qsn_F12;
// Read Input
Res = QsnReadInp(QSN_CC1_NULL:
QSN_CC2_NO_IC:
*Omit:
*Omit:
ihCmdBuf:
*Omit:
*Omit);
// Put and Get Buffer
Res = QsnPutGetBuf(ihCmdBuf:
ihInpBuf:
*Omit:
*Omit);
// Retrieve current window
Res = QsnRtvCurWin(ihWin:
*Omit);
If Res > *Zeros;
Res = *Zeros;
EndIf;
// Get input data
pInputData = QsnRtvDta(ihInpBuf:
*Omit:
*Omit);
Select;
// ENTER key pressed.
When AID = Qsn_Enter;
// Calculate the selected pushbutton
oSltOpt = Row - iRow - Offset;
If oSltOpt < 1 Or
oSltOpt > iNbrElm;
AID = *Allx'00';
// Clear buffers
Res = QsnClrBuf(ihCmdBuf:
*Omit);
If Res >= *Zeros;
Res = QsnClrBuf(ihInpBuf:
*Omit);
EndIf;
EndIf;
// F3 or F12 key pressed.
When AID = Qsn_F3 Or AID = Qsn_F12;
// Do not do anything, as this will terminate the loop.
Other;
AID = *Allx'00';
// Clear buffers
Res = QsnClrBuf(ihCmdBuf:
*Omit);
If Res >= *Zeros;
Res = QsnClrBuf(ihInpBuf:
*Omit);
EndIf;
EndSl;
EndDo;
If Res = -1;
Res = pmResultAPIError;
EndIf;
Return Res;
End-Proc OptionsAsPushBtnChar;
//
// OptionsAsPushBtnGUI
// -------------------
// Build the menu items as GUI push buttons.
Dcl-Proc OptionsAsPushBtnGUI;
Dcl-PI OptionsAsPushBtnGUI Int(10:0);
ihCmdBuf Int(10:0) Const;
ihInpBuf Int(10:0) Const;
ihWin Int(10:0) Const;
iNbrElm Packed(3:0) Const;
iOptions Char(70) Const Dim(15);
iHdrLen Packed(3:0) Const;
iMaxLen Packed(3:0) Const;
iMaxElmLen Packed(3:0) Const;
iRow Packed(3:0) Const;
oSltOpt Packed(3:0);
End-PI;
// Local work fileds.
Dcl-S FieldXPos Packed(3:0);
Dcl-S Idx Zoned(2:0);
Dcl-S Offset Packed(3:0);
Dcl-S PadSpaces Packed(3:0);
Dcl-S pInputData Pointer;
Dcl-S Res Int(10:0);
Dcl-S Spaces Char(75) Inz(*Blanks);
Dcl-S TempString VarChar(70);
Dcl-DS InputData Based(pInputData);
Row Uns(3:0);
Col Uns(3:0);
AID Char(1);
Field Char(500);
End-DS;
oSltOpt = *Zeros;
// Calculate pushbutton start pos
FieldXPos = (iMaxLen - iMaxElmLen) / 2;
// Compensate starting line if no Header
If iHdrLen > *Zeros;
Offset = 3;
Else;
Offset = 1;
EndIf;
// Fill the Major Structure
MJLen = %Size(MJStruc);
MJClass = x'D9';
MJType = x'50';
MJFlag1 = x'04';
MJFlag2 = x'14';
MJFlag3 = x'00';
// Push buttons
MJTPSlt = x'41';
MJGUIDev = x'20';
MJNWSwMne = x'30';
MJNWSwoMne = x'30';
MJRes1 = x'00';
MJRes2 = x'00';
MJTextSize = iMaxElmLen + 2;
MJRows = iNbrElm;
MJCols = 1;
MJPad = 0;
MJNumSep = '0';
MJCounSltChr = '/';
MJMousCnlAID = x'00';
Res = QsnWrtSFMaj(MJStruc:
%Size(MJStruc):
*Omit:
Offset:
FieldXPos:
ihCmdBuf:
*Omit:
*Omit);
// Fill the Minor Structure
MIType = x'10';
MIFlag1 = x'01';
MIFlag2 = x'00';
MIFlag3 = x'e0';
// Loop though the options and draw them
For Idx = 1 to iNbrElm;
// Fill the individual part of Minor Structure
MIValue = '1';
MIChoText = %Trim(iOptions(Idx));
MILen = %Size(MIStruc) - %Size(MIChoText)
+ %Len(%Trim(iOptions(Idx)));
Res = QsnWrtSFMin(MIStruc:
MILen:
ihCmdBuf:
*Omit:
*Omit);
EndFor;
// Loop until valid input
DoU AID = Qsn_Enter Or
AID = Qsn_F3 Or
AID = Qsn_F12;
// Read Input
Res = QsnReadInp(QSN_CC1_NULL:
QSN_CC2_NO_IC:
*Omit:
*Omit:
ihCmdBuf:
*Omit:
*Omit);
// Put and Get Buffer
Res = QsnPutGetBuf(ihCmdBuf:
ihInpBuf:
*Omit:
*Omit);
// Retrieve current window
Res = QsnRtvCurWin(ihWin:
*Omit);
If Res > *Zeros;
Res = *Zeros;
EndIf;
// Get input data
pInputData = QsnRtvDta(ihInpBuf:
*Omit:
*Omit);
Select;
// ENTER key pressed.
When AID = Qsn_Enter;
// Calculate the selected pushbutton
oSltOpt = Row - iRow - Offset + 1;
If oSltOpt < 1 Or
oSltOpt > iNbrElm;
AID = *Allx'00';
// Clear buffers
Res = QsnClrBuf(ihCmdBuf:
*Omit);
If Res >= *Zeros;
Res = QsnClrBuf(ihInpBuf:
*Omit);
EndIf;
EndIf;
// F3 or F12 key pressed.
When AID = Qsn_F3 Or AID = Qsn_F12;
// Do not do anything, as this will terminate the loop.
Other;
AID = *Allx'00';
// Clear buffers
Res = QsnClrBuf(ihCmdBuf:
*Omit);
If Res >= *Zeros;
Res = QsnClrBuf(ihInpBuf:
*Omit);
EndIf;
EndSl;
EndDo;
If Res = -1;
Res = pmResultAPIError;
EndIf;
Return Res;
End-Proc OptionsAsPushBtnGUI;
//
// ValidateParms
// -------------
// Validates that the input parms are within limits.
Dcl-Proc ValidateParms;
Dcl-PI ValidateParms Packed(3:0);
iLocation Packed(3:0) Const;
iRow Packed(3:0) Const;
iCol Packed(3:0) Const;
iBorder Packed(3:0) Const;
iStyle Packed(3:0) Const;
iOptions Char(70) Const Dim(15);
End-PI;
// Local work fields.
Dcl-S RtnCode Packed(3:0) Inz(*Zeros);
Select;
// Location
When iLocation < pmLocationCenter Or
iLocation > pmLocationRowCol;
RtnCode = pmResultLocationInvalid;
// Row
When iRow < *Zeros Or
iRow > 27;
RtnCode = pmResultRowInvalid;
// Col
When iCol < *Zeros Or
iCol > 132;
RtnCode = pmResultColInvalid;
// Style
When iStyle < pmStyleClassic Or
iStyle > pmStylePushBtn;
RtnCode = pmResultStyleInvalid;
// Border
When iBorder < pmBorderDefault Or
iBorder > pmBorderAlert;
RtnCode = pmResultBorderInvalid;
// Options
When iOptions(1) = *Blanks;
RtnCode = pmResultNoOptions;
EndSl;
Return RtnCode;
End-Proc ValidateParms;
If you have installed Jesper’s ToolBox for IBM i you can use the Make member in Listing 4 to compile the module and the example program.
Listing 4, member POPMNU_MK, type TXT:
;
; POPMNU_MK
; ---------
; Make member for the module and command POPMNU.
;
v &lib jwtools
v &srclib jwtools
v &proto PopMnu_Pr
v &debug *source
;
; Check and possibly build PopMnu module.
;
v &mod1 PopMnu
o &srclib &mod1 *module
u &srclib qrpglesrc *file &mod1
u &srclib qrpglesrc *file &proto
u &srclib qrpglesrc *file qsnapiw_h
ci dltmod &srclib/&mod1
c crtrpgmod &srclib/&mod1 srcfile(&srclib/qrpglesrc) dbgview(&debug)
;
; Check and possibly build PopMnu_Ex1 module.
;
v &mod2 PopMnu_Ex
o &srclib &mod2 *module
u &srclib qrpglesrc *file &mod2
u &srclib qrpglesrc *file &proto
ci dltmod &srclib/&mod2
c crtrpgmod &srclib/&mod2 srcfile(&srclib/qrpglesrc) dbgview(&debug)
;
; Build main program.
;
v &pgm PopMnu_Ex
o &lib &pgm *pgm
u &srclib &mod1 *module
u &srclib &mod2 *module
ci DltPgm &lib/&pgm
c CrtPgm &lib/&pgm module(&srclib/&mod1 &srclib/&mod2)
Listing 5, member QSNAPIW_H, type RPGLE
**Free
//
// Prototypes for DSM APIs
// -----------------------
// All DSM Windows API declarations added by Jesper Wachs, December 2018.
//
//
// Copyright (c) 2004 Scott C. Klement
// All rights reserved.
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions
// are met:
// 1. Redistributions of source code must retain the above copyright
// notice, this list of conditions and the following disclaimer.
// 2. Redistributions in binary form must reproduce the above copyright
// notice, this list of conditions and the following disclaimer in the
// documentation and/or other materials provided with the distribution.
//
// THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
// ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPO
// ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
// FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTI
// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRI
// LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WA
// OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
// SUCH DAMAGE.
//
/If Defined(QSNAPIW_H)
/Eof
/EndIf
/Define QSNAPIW_H
// Standard DSM APIs
// -----------------
Dcl-PR QsnClrBuf Int(10:0) ExtProc('QsnClrBuf');
BufHandle Int(10:0) Const;
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnCrtCmdBuf Int(10:0) ExtProc('QsnCrtCmdBuf');
InitSize Int(10:0) Const;
IncrAmt Int(10:0) Const Options(*Omit);
MaxSize Int(10:0) Const Options(*Omit);
Handle Int(10:0) Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnCrtInpBuf Int(10:0) ExtProc('QsnCrtInpBuf');
BufSize Int(10:0) Const;
IncrAmt Int(10:0) Const Options(*Omit);
MaxSize Int(10:0) Const Options(*Omit);
Handle Int(10:0) Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnDltBuf Int(10:0) ExtProc('QsnDltBuf');
BufHandle Int(10:0) Const;
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnDltEnv Int(10:0) ExtProc('QsnDltEnv');
Environment Int(10:0);
ErrorCode Char(32767) Const Options(*Omit:
*VarSize);
End-PR;
Dcl-PR QsnGetAID Char(1) ExtProc('QsnGetAID');
AIDChar Char(1) Options(*Omit);
LowLvlEnvHnd Int(10:0) Const Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnGetCsrAdr Int(10:0) ExtProc('QsnGetCsrAdr');
CsrRow Int(10:0) Const Options(*Omit);
CsrCol Int(10:0) Const Options(*Omit);
LowLvlEnvHnd Int(10:0) Const Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnPutBuf Int(10:0) ExtProc('QsnPutBuf');
CmdBufHnd Int(10:0) Const;
LowLvlEnvHnd Int(10:0) Const Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnPutGetBuf Int(10:0) ExtProc('QsnPutGetBuf');
CmdBufHandle Int(10:0) Const;
InpBufHandle Int(10:0) Const;
LowEnvHandle Int(10:0) Const Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnReadInp Int(10:0) ExtProc('QsnReadInp');
CC1 Char(1) Const;
CC2 Char(1) Const;
DataBytes Int(10:0) Options(*Omit);
InpBufHandle Int(10:0) Options(*Omit) Const;
CmdBufHandle Int(10:0) Options(*Omit) Const;
LowEnvHandle Int(10:0) Options(*Omit) Const;
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnRtvDta Pointer ExtProc('QsnRtvDta');
InpBufHandle Int(10:0) Const;
PtrToData Pointer Const Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnRtvDtaLen Int(10:0) ExtProc('QsnRtvDtaLen');
InpBufHandle Int(10:0) Const;
DataLen Int(10:0) Const Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnRtvMod Int(10:0) ExtProc('QsnRtvMod');
QsnDspMod Char(1) Options(*Omit);
QsnLowLvlEnv Int(10:0) Const Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnSetCsrAdr Int(10:0) ExtProc('QsnSetCsrAdr');
FldNbr Int(10:0) Const Options(*Omit);
CsrRow Int(10:0) Const Options(*Omit);
CsrCol Int(10:0) Const Options(*Omit);
CmdBuf Int(10:0) Const Options(*Omit);
LowLvlEnvHnd Int(10:0) Const Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnSetFld Int(10:0) ExtProc('QsnSetFld');
FieldID Int(10:0) Const Options(*Omit);
FieldLen Int(10:0) Const Options(*Omit);
Row Int(10:0) Const Options(*Omit);
Column Int(10:0) Const Options(*Omit);
FFW Char(2) Const Options(*Omit);
FCW Char(2) Const
Dim(32767)
Options(*Omit: *VarSize);
NumOfFCW Int(10:0) Const Options(*Omit);
MonoAttr Char(1) Const Options(*Omit);
ColorAttr Char(1) Const Options(*Omit);
CmdBufHandle Int(10:0) Const Options(*Omit);
LowEnvHandle Int(10:0) Const Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnQry5250 Int(10:0) ExtProc('QsnQry5250');
Qry5250Cap Char(64) Options(*VarSize);
Qry5250CapL Int(10:0) Const;
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnWrtDta Int(10:0) ExtProc('QsnWrtDta');
Data Char(32767) Const Options(*VarSize);
DataLen Int(10:0) Const;
FieldID Int(10:0) Const Options(*Omit);
Row Int(10:0) Const Options(*Omit);
Column Int(10:0) Const Options(*Omit);
StrMonoAttr Char(1) Const Options(*Omit);
EndMonoAttr Char(1) Const Options(*Omit);
StrColorAttr Char(1) Const Options(*Omit);
EndColorAttr Char(1) Const Options(*Omit);
CmdBufHandle Int(10:0) Const Options(*Omit);
LowEnvHandle Int(10:0) Const Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnWrtSFMaj Int(10:0) ExtProc('QsnWrtSFMaj');
MajStruc Char(30) Const Options(*VarSize);
MajStrucLen Int(10:0) Const;
SFMajFldID Int(10:0) Const Options(*Omit);
SFMajRow Int(10:0) Const Options(*Omit);
SFMajCol Int(10:0) Const Options(*Omit);
SFMajCmdBuf Int(10:0) Const Options(*Omit);
SFLowLvlEnv Int(10:0) Const Options(*Omit);
SFErrorCode Char(32767) Const Options(*Omit:
*VarSize);
End-PR;
Dcl-PR QsnWrtSFMin Int(10:0) ExtProc('QsnWrtSFMin');
MinStruc Char(80) Const Options(*VarSize);
MinStrucLen Int(10:0) Const;
SFMinCmdBuf Int(10:0) Const;
SFMinLowLvl Int(10:0) Const Options(*Omit);
SFErrorCode Char(32767) Const Options(*Omit:
*VarSize);
End-PR;
//
// Window DSM APIs
// ---------------
Dcl-PR QsnCrtWin Int(10:0) ExtProc('QsnCrtWin');
WinDesc Char(156) Const Options(*VarSize);
WinDescL Int(10:0) Const;
UsrExtInf Char(32767) Const Options(*Omit:
*VarSize);
UsrExtInfL Int(10:0) Const Options(*Omit);
StartWindow Char(1) Const Options(*Omit);
LowLvEnvDes Char(32767) Const Options(*Omit:
*VarSize);
LowLvEnvDesL Int(10:0) Const Options(*Omit);
WindowHnd Int(10:0) Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnEndWin Int(10:0) ExtProc('QsnEndWin');
WinHnd Int(10:0) Const;
RestoreScn Char(1) Const Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnInzWinD Int(10:0) ExtProc('QsnInzWinD');
WinDesc Char(77) Const Options(*VarSize);
WinDescLen Int(10:0) Const;
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnRtvCurWin Int(10:0) ExtProc('QsnRtvCurWin');
CurWinHnd Int(10:0) Const;
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnSetCurWin Int(10:0) ExtProc('QsnSetCurWin');
WinHnd Int(10:0) Const;
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
Dcl-PR QsnSetEnvWinMod Int(10:0) ExtProc('QsnSetEnvWinMod');
EnableWin Char(1) Const;
PrvWinModSet Char(1) Options(*Omit);
WinModDesc Char(156) Options(*Omit: *VarSize);
WinModDescL Int(10:0) Const Options(*Omit);
LowLvlEnvHnd Int(10:0) Const Options(*Omit);
ErrorCode Char(32767) Options(*Omit: *VarSize);
End-PR;
//
// Standard DSM API structures
// ---------------------------
// Data structure for QsnQry5250 API.
//
Dcl-DS QsnQ5250;
QsnQ5Ret Int(10:0);
QsnQ5Avl Int(10:0);
QsnQ5Stat Char(1);
QsnQ5Wkstn BinDec(4:0);
QsnQ5CLvl Char(3);
QsnQ5R1 Char(16);
QsnQ5WType Char(1);
QsnQ5MType Char(4);
QsnQ5Model Char(3);
QsnQ5KbdID Char(1);
QsnQ5EKbd Char(1);
QsnQ5PcKbd Char(1);
QsnQ5SNum Char(4);
QsnQ5MaxIn BinDec(4:0);
QsnQ5WSCSp Char(2);
QsnQ5R2 Char(1);
QsnQ5WSCB1 Char(1);
QsnQ5WSCB2 Char(1);
QsnQ5WSCB3 Char(1);
QsnQ5WSCB4 Char(1);
QsnQ5WSCB5 Char(1);
QsnQ5R3 Char(5);
QsnQ5Prt Char(1);
QsnQ5R4 Char(1);
QsnQ5GrdBf Char(1);
QsnQ5R5 Char(9);
End-DS;
//
// Window DSM API structures
// -------------------------
// Data structures for QsnSetEnvWinMod API.
//
Dcl-DS QsnEnvWM;
QsnEWAtrC Char(1);
QsnEWULR Int(10:0);
QsnEWULC Int(10:0);
QsnEWNumR Int(10:0);
QsnEWNumC Int(10:0);
End-DS;
//
//
//
Dcl-DS MJStruc;
MJLen Int(5:0);
MJClass Char(1);
MJType Char(1);
MJFlag1 Char(1);
MJFlag2 Char(1);
MJFlag3 Char(1);
MJTPSlt Char(1);
MJGUIDev Char(1);
MJNWSwMne Char(1);
MJNWSwoMne Char(1);
MJRes1 Char(1);
MJRes2 Char(1);
MJTextSize Int(3:0);
MJRows Int(3:0);
MJCols Int(3:0);
MJPad Int(3:0);
MJNumSep Char(1);
MJCounSltChr Char(1);
MJMousCnlAID Char(1);
End-DS;
//
//
//
Dcl-DS MIStruc;
MILen Int(3:0);
MIType Char(1);
MIFlag1 Char(1);
MIFlag2 Char(1);
MIFlag3 Char(1);
MIValue Char(1);
MIChoText Char(70);
End-DS;
//
// Data structures for QsnCrtWin and QsnChgWin APIs.
//
Dcl-DS QsnWinD;
QsnWTopR Int(10:0);
QsnWLeftC Int(10:0);
QsnWNumR Int(10:0);
QsnWNumC Int(10:0);
QsnWMinR Int(10:0);
QsnWMinC Int(10:0);
QsnWMaxR Int(10:0);
QsnWMaxC Int(10:0);
QsnWFS Char(1);
QsnWAtrM1 Char(1);
QsnWAtrM2 Char(1);
QsnWAtrM3 Char(1);
QsnWAtrC1 Char(1);
QsnWAtrC2 Char(1);
QsnWAtrC3 Char(1);
QsnWShowB Char(1);
QsnWShowBA Char(1);
QsnWShowLA Char(1);
QsnWShowRA Char(1);
QsnWMsgL Char(1);
QsnWULCh Char(1);
QsnWTopCh Char(1);
QsnWURCh Char(1);
QsnWLCh Char(1);
QsnWRCh Char(1);
QsnWLLCh Char(1);
QsnWBotCh Char(1);
QsnWLRCh Char(1);
QsnWGUI Char(1);
QsnWFlg1 Char(1);
QsnWFlg2 Char(1);
QsnWR1 Char(1);
QsnWBdrF Char(1);
QsnWTtlF Char(1);
QsnWTAtrM Char(1);
QsnWTAtrC Char(1);
QsnWR2 Char(1);
QsnWR3 Char(3);
QsnWTtlO Int(10:0);
QsnWTtlL Int(10:0);
QsnWR4 Int(10:0);
QsnWTtl Char(70);
End-DS;
//
// Standard DSM API constants
// --------------------------
// AID keys
//
Dcl-C QSN_F1 x'31';
Dcl-C QSN_F2 x'32';
Dcl-C QSN_F3 x'33';
Dcl-C QSN_F4 x'34';
Dcl-C QSN_F5 x'35';
Dcl-C QSN_F6 x'36';
Dcl-C QSN_F7 x'37';
Dcl-C QSN_F8 x'38';
Dcl-C QSN_F9 x'39';
Dcl-C QSN_F10 x'3A';
Dcl-C QSN_F11 x'3B';
Dcl-C QSN_F12 x'3C';
Dcl-C QSN_F13 x'B1';
Dcl-C QSN_F14 x'B2';
Dcl-C QSN_F15 x'B3';
Dcl-C QSN_F16 x'B4';
Dcl-C QSN_F17 x'B5';
Dcl-C QSN_F18 x'B6';
Dcl-C QSN_F19 x'B7';
Dcl-C QSN_F20 x'B8';
Dcl-C QSN_F21 x'B9';
Dcl-C QSN_F22 x'BA';
Dcl-C QSN_F23 x'BB';
Dcl-C QSN_F24 x'BC';
Dcl-C QSN_SLP x'3F';
Dcl-C QSN_FET x'50';
Dcl-C QSN_PA1 x'6C';
Dcl-C QSN_PA2 x'6E';
Dcl-C QSN_PA3 x'6B';
Dcl-C QSN_CLEAR x'BD';
Dcl-C QSN_ENTER x'F1';
Dcl-C QSN_HELP x'F3';
Dcl-C QSN_ROLLDOWN x'F4';
Dcl-C QSN_ROLLUP x'F5';
Dcl-C QSN_PAGEUP x'F4';
Dcl-C QSN_PAGEDOWN x'F5';
Dcl-C QSN_PRINT x'F6';
Dcl-C QSN_RECBS x'F8';
// Control Characters
Dcl-C QSN_CC1_NULL x'00';
Dcl-C QSN_CC1_LOCKBD x'20';
Dcl-C QSN_CC1_MDTNBY x'40';
Dcl-C QSN_CC1_MDTALL x'60';
Dcl-C QSN_CC1_CLRMOD x'80';
Dcl-C QSN_CC1_MDTNBY_CLRALL x'A0';
Dcl-C QSN_CC1_MDTNBY_CLRMOD x'C0';
Dcl-C QSN_CC1_MDTALL_CLRALL x'E0';
Dcl-C QSN_CC2_NULL x'00';
Dcl-C QSN_CC2_NO_IC x'40';
Dcl-C QSN_CC2_RST_CSR_BL x'20';
Dcl-C QSN_CC2_SET_CSR_BL x'10';
Dcl-C QSN_CC2_UNLOCKBD x'08';
Dcl-C QSN_CC2_ALARM x'04';
Dcl-C QSN_CC2_MSG_OFF x'02';
Dcl-C QSN_CC2_MSG_ON x'01';
//
// Field Format Words
//
Dcl-C QSN_NO_FFW x'0000';
Dcl-C QSN_FFW_BYPASS x'6000';
Dcl-C QSN_FFW_DUP x'5000';
Dcl-C QSN_FFW_MDT x'4800';
Dcl-C QSN_FFW_ALPHA_SHIFT x'4000';
Dcl-C QSN_FFW_ALPHA_ONLY x'4100';
Dcl-C QSN_FFW_NUM_SHIFT x'4200';
Dcl-C QSN_FFW_NUM_ONLY x'4300';
Dcl-C QSN_FFW_KATA x'4400';
Dcl-C QSN_FFW_DIGIT_ONLY x'4500';
Dcl-C QSN_FFW_IO x'4600';
Dcl-C QSN_FFW_SIGNED_NUMERIC x'4700';
Dcl-C QSN_FFW_AUTO_ENTER x'4080';
Dcl-C QSN_FFW_FER x'4040';
Dcl-C QSN_FFW_AUTO_FER x'4040';
Dcl-C QSN_FFW_MONOCASE x'4020';
Dcl-C QSN_FFW_AUTO_MONOCASE x'4020';
Dcl-C QSN_FFW_ME x'4008';
Dcl-C QSN_FFW_NOADJUST x'4000';
Dcl-C QSN_FFW_RA_ZERO x'4005';
Dcl-C QSN_FFW_RA_BLANK x'4006';
Dcl-C QSN_FFW_MF x'4007';
Dcl-C QSN_FCW_RESEQ x'8000';
Dcl-C QSN_FCW_MSR x'8101';
Dcl-C QSN_FCW_SLP x'8102';
Dcl-C QSN_FCW_MSR_SLP x'8103';
Dcl-C QSN_FCW_SLP_SA x'8106';
Dcl-C QSN_FCW_DBCS_ONLY x'8200';
Dcl-C QSN_FCW_DBCS_PURE x'8220';
Dcl-C QSN_FCW_DBCS_EITHER x'8240';
Dcl-C QSN_FCW_DBCS_OPEN x'8280';
Dcl-C QSN_FCW_DBCS_OPEN_CO x'82C0';
Dcl-C QSN_FCW_TRANSPARENT x'8400';
Dcl-C QSN_FCW_FET x'8501';
Dcl-C QSN_FCW_CONT_FIRST x'8601';
Dcl-C QSN_FCW_CONT_LAST x'8602';
Dcl-C QSN_FCW_CONT_MIDDLE x'8603';
Dcl-C QSN_FCW_CP x'8800';
Dcl-C QSN_FCW_HL x'8900';
Dcl-C QSN_FCW_PDS x'8A00';
Dcl-C QSN_FCW_MOD11 x'B140';
Dcl-C QSN_FCW_MOD10 x'B1A0';
Dcl-C QSN_READ_INP x'42';
Dcl-C QSN_READ_MDT x'52';
Dcl-C QSN_READ_IMM x'72';
Dcl-C QSN_READ_MDT_ALT x'82';
//
// Screen Attributes
//
Dcl-C QSN_NO_SA x'00';
Dcl-C QSN_SA_NORM x'20';
Dcl-C QSN_SA_CS x'30';
Dcl-C QSN_SA_BL x'28';
Dcl-C QSN_SA_UL x'24';
Dcl-C QSN_SA_HI x'22';
Dcl-C QSN_SA_RI x'21';
Dcl-C QSN_SA_ND x'27';
Dcl-C QSN_SA_GRN x'20';
Dcl-C QSN_SA_GRN_RI x'21';
Dcl-C QSN_SA_WHT x'22';
Dcl-C QSN_SA_WHT_RI x'23';
Dcl-C QSN_SA_GRN_UL x'24';
Dcl-C QSN_SA_GRN_UL_RI x'25';
Dcl-C QSN_SA_WHT_UL x'26';
Dcl-C QSN_SA_RED x'28';
Dcl-C QSN_SA_RED_RI x'29';
Dcl-C QSN_SA_RED_BL x'2A';
Dcl-C QSN_SA_RED_RI_BL x'2B';
Dcl-C QSN_SA_RED_UL x'2C';
Dcl-C QSN_SA_RED_UL_RI x'2D';
Dcl-C QSN_SA_RED_UL_BL x'2E';
Dcl-C QSN_SA_ND_2F x'2F';
Dcl-C QSN_SA_TRQ_CS x'30';
Dcl-C QSN_SA_TRQ_CS_RI x'31';
Dcl-C QSN_SA_YLW_CS x'32';
Dcl-C QSN_SA_YLW_CS_RI x'33';
Dcl-C QSN_SA_TRQ_UL x'34';
Dcl-C QSN_SA_TRQ_UL_RI x'35';
Dcl-C QSN_SA_YLW_UL x'36';
Dcl-C QSN_SA_ND_37 x'37';
Dcl-C QSN_SA_PNK x'38';
Dcl-C QSN_SA_PNK_RI x'39';
Dcl-C QSN_SA_BLU x'3A';
Dcl-C QSN_SA_BLU_RI x'3B';
Dcl-C QSN_SA_PNK_UL x'3C';
Dcl-C QSN_SA_PNK_UL_RI x'3D';
Dcl-C QSN_SA_BLU_UL x'3E';
Dcl-C QSN_SA_ND_3F x'3F';